Squeak-dev September 2022

squeak-dev@lists.squeakfoundation.org

29 participants
157 discussions

The Inbox: Compiler-ct.480.mcz
by commits＠source.squeak.org 14 Sep '22

14 Sep '22

A new version of Compiler was added to project The Inbox: http://source.squeak.org/inbox/Compiler-ct.480.mcz ==================== Summary ==================== Name: Compiler-ct.480 Author: ct Time: 9 September 2022, 2:48:27.444614 pm UUID: 03d9ed0c-8807-be4a-89bf-891d9f639f09 Ancestors: Compiler-eem.479 Attempts to fix a GC issue while creating an Undeclared variable. Hold a strong reference on the newly created association until it has been stored as a global. Note: This change makes the assumption that undeclared is not a SystemDictionary, which overrides #at:put:. However, I cannot explain why AttemptToWriteReadOnlyGlobal is handled in this place, no idea how this code could touch any ClassBindings ... Please review. =============== Diff against Compiler-eem.479 =============== Item was added: + (PackageInfo named: 'Compiler') preamble: '"Make sure closures are initialized before starting to use them" + Utilities initializeClosures. + '! Item was added: + SystemOrganization addCategory: #'Compiler-Exceptions'! + SystemOrganization addCategory: #'Compiler-Kernel'! + SystemOrganization addCategory: #'Compiler-ParseNodes'! + SystemOrganization addCategory: #'Compiler-Support'! + SystemOrganization addCategory: #'Compiler-Syntax'! Item was added: + ParserNotification subclass: #AmbiguousSelector + instanceVariableNames: 'interval' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Exceptions'! + + !AmbiguousSelector commentStamp: 'nice 2/23/2010 15:40' prior: 0! + An AmbiguousSelector is a notification produced by the Scanner/Parser/Compiler when encountering this ambiguous construct: + + 1@-2 + + Upper expression can be interpreted both + 1 @ -2 (regular st-80 and former Squeak syntax, the minus is attached to the literal number) + 1 @- 2 (extended binary selector, the minus sign is allowed at any position and thus part of the binary selector) + ! Item was added: + ----- Method: AmbiguousSelector class>>signalName:inRange: (in category 'instance creation') ----- + signalName: aString inRange: anInterval + ^ (self new setName: aString range: anInterval) signal! Item was added: + ----- Method: AmbiguousSelector>>openMenuIn: (in category 'handling') ----- + openMenuIn: aBlock + "Ask the user which selector to choose. + Answer the choosen selector or nil if cancellation is requested." + + | labels actions lines caption choice | + labels := { + ('selector is {1} and argument is negative' translated format: {name copyFrom: 1 to: name size - 1}). + ('selector is {1} and argument is positive' translated format: {name}). + 'cancel' translated}. + actions := { + name copyReplaceFrom: name size to: name size - 1 with: ' '. + name copyReplaceFrom: name size + 1 to: name size with: ' '. + nil. + }. + lines := {2}. + caption := 'Ambiguous selector: {1} please correct, or cancel:' translated format: {name}. + choice := aBlock value: labels value: lines value: caption. + self resume: (actions at: choice ifAbsent: [nil])! Item was added: + ----- Method: AmbiguousSelector>>setName:range: (in category 'initialization') ----- + setName: aString range: anInterval + name := aString. + interval := anInterval! Item was added: + ParseNode subclass: #AssignmentNode + instanceVariableNames: 'variable value' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !AssignmentNode commentStamp: '<historical>' prior: 0! + AssignmentNode comment: 'I represent a (var_expr) construct.'! Item was added: + ----- Method: AssignmentNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitAssignmentNode: self! Item was added: + ----- Method: AssignmentNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + "N.B. since assigment happens _after_ the value is evaluated the value is sent the message _first_." + value analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools. + variable beingAssignedToAnalyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools! Item was added: + ----- Method: AssignmentNode>>emitCodeForEffect:encoder: (in category 'code generation') ----- + emitCodeForEffect: stack encoder: encoder + + variable emitCodeForLoad: stack forValue: false encoder: encoder. + value emitCodeForValue: stack encoder: encoder. + pc := encoder nextPC. "debug pc is first byte of the store, i.e. the next byte". + variable emitCodeForStorePop: stack encoder: encoder! Item was added: + ----- Method: AssignmentNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + + variable emitCodeForLoad: stack forValue: true encoder: encoder. + value emitCodeForValue: stack encoder: encoder. + pc := encoder nextPC. "debug pc is first byte of the store, i.e. the next byte". + variable emitCodeForStore: stack encoder: encoder! Item was added: + ----- Method: AssignmentNode>>ifNilTemporary (in category 'private') ----- + ifNilTemporary + "(temp := object) == nil ifTrue: [...] ifFalse: [...]" + + ^ self variable! Item was added: + ----- Method: AssignmentNode>>ifNilValue (in category 'private') ----- + ifNilValue + "(temp := object) == nil ifTrue: [...] ifFalse: [...]" + + ^ self value! Item was added: + ----- Method: AssignmentNode>>isAssignmentNode (in category 'testing') ----- + isAssignmentNode + ^true! Item was added: + ----- Method: AssignmentNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + variable printOn: aStream indent: level. + aStream nextPutAll: ' := '. + value printOn: aStream indent: level + 2! Item was added: + ----- Method: AssignmentNode>>printOn:indent:precedence: (in category 'printing') ----- + printOn: aStream indent: level precedence: p + + aStream nextPut: $(. + self printOn: aStream indent: level. + aStream nextPut: $)! Item was added: + ----- Method: AssignmentNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + variable printWithClosureAnalysisOn: aStream indent: level. + aStream nextPutAll: ' := '. + value printWithClosureAnalysisOn: aStream indent: level + 2! Item was added: + ----- Method: AssignmentNode>>printWithClosureAnalysisOn:indent:precedence: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level precedence: p + + aStream nextPut: $(. + self printWithClosureAnalysisOn: aStream indent: level. + aStream nextPut: $)! Item was added: + ----- Method: AssignmentNode>>sizeCodeForEffect: (in category 'code generation') ----- + sizeCodeForEffect: encoder + + ^(variable sizeCodeForLoad: encoder forValue: false) + + (value sizeCodeForValue: encoder) + + (variable sizeCodeForStorePop: encoder)! Item was added: + ----- Method: AssignmentNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + + ^(variable sizeCodeForLoad: encoder forValue: true) + + (value sizeCodeForValue: encoder) + + (variable sizeCodeForStore: encoder)! Item was added: + ----- Method: AssignmentNode>>toDoIncrement: (in category 'initialize-release') ----- + toDoIncrement: var + ^(var = variable + and: [value isMessageNode]) ifTrue: + [value toDoIncrement: var]! Item was added: + ----- Method: AssignmentNode>>value (in category 'initialize-release') ----- + value + ^ value! Item was added: + ----- Method: AssignmentNode>>variable (in category 'equation translation') ----- + variable + ^variable! Item was added: + ----- Method: AssignmentNode>>variable:value: (in category 'initialize-release') ----- + variable: aVariable value: expression + + variable := aVariable. + value := expression! Item was added: + ----- Method: AssignmentNode>>variable:value:from: (in category 'initialize-release') ----- + variable: aVariable value: expression from: encoder + + (aVariable isMemberOf: MessageAsTempNode) + ifTrue: ["Case of remote temp vars" + ^ aVariable store: expression from: encoder]. + variable := aVariable. + value := expression! Item was added: + ----- Method: AssignmentNode>>variable:value:from:sourceRange: (in category 'initialize-release') ----- + variable: aVariable value: expression from: encoder sourceRange: range + + encoder noteSourceRange: range forNode: self. + ^self + variable: aVariable + value: expression + from: encoder! Item was added: + ParseNode subclass: #BlockArgsNode + instanceVariableNames: 'temporaries' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Syntax'! Item was added: + ParseNode subclass: #BlockNode + instanceVariableNames: 'arguments statements returns nArgsNode size temporaries optimized optimizedMessageNode actualScopeIfOptimized blockExtent remoteTempNode copiedValues closureCreationNode startOfLastStatement tempsMark' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !BlockNode commentStamp: 'ct 1/17/2020 13:05' prior: 0! + I represent a bracketed block with 0 or more arguments and 1 or more statements. If I am initialized with no statements, I create one. I have a flag to tell whether my last statement returns a value from the enclosing method. I can emit for value in the usual way, in which case I create a BlockClosure to be evaluated by sending it value: at run time. Or I can emit code to be evaluated in line; this only happens at the top level of a method and in certain optimized control structures (see MessageNode class>>initialize MacroSelectors). + + Instance Variables + actualScopeIfOptimized: <nil | BlockNode> + arguments: <SequencableCollection of: TempVariableNode> + blockExtent: <nil | Interval> + closureCreationNode: <LeafNode> + copiedValues: <nil | (SequencableCollection of: TempVariableNode)> + nArgsNode: <nil | Integer> + optimized: <Boolean> + optimizedMessageNode: <nil | MessageNode> + remoteTempNode: <nil | RemoteTempVectorNode> + returns: <Boolean> + size: <nil | Integer> + startOfLastStatement: <nil | Integer> + statements: <SequencableCollection of: ParseNode> + temporaries: <SequencableCollection of: TempVariableNode> + tempsMark: <nil | Integer> + + actualScopeIfOptimized + - if the receiver has been inlined this is the non-optimized BlockNode the receiver is inlined into. + + arguments + - the sequence of arguments to the block (or method if a top-level block) + + blockExtent + - the interval defining the range of block scopes the receiver comprises, which is itself and any blocks it may contain. See #analyseArguments:temporaries:rootNode: + + closureCreationNode + - a place-holder representing the body of the block. + + copiedValues + - blocks do not reference the temporary variables of their outer context they close over directly; instead, temporary variables which won't change value are collected and copied into the block, and temporary variables that are modified either within the block or after it has closed over the variables are allocated in a remote temp vector that again becomes one of the block's copied values. In this way, a block refers to the outer temporaries it closes over only through copiedValues. copiedValues is the sequence of these TempVariableNodes. + + nArgsNode + - a place holder for the encoder to allow it to number block temporaries + + optimized + - true if the receiver is inlined, false if a true block + + optimizedMessageNode + - the MessageNode in which the receiver is optimized, if it is optimized. + + remoteTempNode + - if any of the blocks nested into the receiver either modify a temp or access a temp that is modified after the block is created, then this temp is allocated remotely in a remote temp vector that allows the temp's location to be shared between blocks. This is the node that creates the remote temp vector. + + returns + - true if the receiver contains a method return. + + size + - the size of the block's bytecodes if it is generated by embedding its bytecodes within an enclosing CompiledMethod. + + startOfLastStatement + - the index in the source of the start of the last statement in the block. + + statements + - the sequence of statements comprising the receiver + + temporaries + - the sequence of temporaries (including the remoteTempNode if any) of block-local temporaries + + tempsMark + - the index in the source of the last block-local temporary, used to auto-insert temps declared during compilation! Item was added: + ----- Method: BlockNode class>>statements:returns: (in category 'instance creation') ----- + statements: statements returns: returns + ^ self new statements: statements returns: returns! Item was added: + ----- Method: BlockNode class>>withJust: (in category 'instance creation') ----- + withJust: aNode + ^ self new statements: (Array with: aNode) returns: false! Item was added: + ----- Method: BlockNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitBlockNode: self! Item was added: + ----- Method: BlockNode>>actualScope (in category 'closure analysis') ----- + actualScope + "Answer the actual scope for the receiver. If this is an unoptimized block then it is its + actual scope, but if this is an optimized block then the actual scope is some outer block." + ^actualScopeIfOptimized ifNil: [self]! Item was added: + ----- Method: BlockNode>>addArgument: (in category 'accessing') ----- + addArgument: aTempVariableNode + temporaries := temporaries copyWith: aTempVariableNode! Item was added: + ----- Method: BlockNode>>addHoistedTemps: (in category 'closure analysis') ----- + addHoistedTemps: additionalTemporaries "<SequenceableCollection>" + | tempsToBeMerged additionalTempsToAdd | + additionalTemporaries do: + [:temp| + temp definingScope ifNil: + [temp definingScope: self]]. + (temporaries isNil or: [temporaries isEmpty]) ifTrue: + [temporaries := additionalTemporaries copy. + ^self]. + tempsToBeMerged := additionalTemporaries select: + [:t| + t isBlockArg + and: [temporaries anySatisfy: [:existing| existing isBlockArg and: [existing key = t key]]]]. + additionalTempsToAdd := tempsToBeMerged isEmpty + ifTrue: [additionalTemporaries copy] + ifFalse: [additionalTemporaries reject: [:temp| tempsToBeMerged identityIncludes: temp]]. + temporaries := (temporaries isNil or: [temporaries isEmpty]) + ifTrue: [additionalTempsToAdd] + ifFalse: + [temporaries last isIndirectTempVector + ifTrue: [temporaries allButLast, additionalTempsToAdd, { temporaries last }] + ifFalse: [temporaries, additionalTempsToAdd]]. + tempsToBeMerged do: + [:t| | merge | + merge := temporaries detect: [:existing| existing isBlockArg and: [existing key = t key]]. + merge absorbHoistedTemp: t]! Item was added: + ----- Method: BlockNode>>addRemoteTemp:rootNode: (in category 'closure analysis') ----- + addRemoteTemp: aTempVariableNode rootNode: rootNode "<MethodNode>" + "Add aTempVariableNode to my actualScope's sequence of + remote temps. If I am an optimized block then the actual + scope is my actualScopeIfOptimized, otherwise it is myself." + remoteTempNode == nil ifTrue: + [remoteTempNode := RemoteTempVectorNode new + name: self remoteTempNodeName + index: arguments size + temporaries size + type: LdTempType + scope: 0. + actualScopeIfOptimized + ifNil: + [self addTempNode: remoteTempNode. + remoteTempNode definingScope: self] + ifNotNil: [actualScopeIfOptimized addHoistedTemps: { remoteTempNode }]]. + remoteTempNode addRemoteTemp: aTempVariableNode encoder: rootNode encoder. + "use remove:ifAbsent: because the deferred analysis for optimized + loops can result in the temp has already been hoised into the root." + self removeTempNode: aTempVariableNode ifAbsent: [ + self actualScope removeTempNode: aTempVariableNode ifAbsent: ["should not happen"]]. + ^remoteTempNode! Item was added: + ----- Method: BlockNode>>addTempNode: (in category 'closure analysis') ----- + addTempNode: aTempVariableNode + "Utilities for when we want to add some temporaries." + + self makeTemporariesRemovable. + ^temporaries add: aTempVariableNode! Item was added: + ----- Method: BlockNode>>analyseArguments:temporaries:rootNode: (in category 'closure analysis') ----- + analyseArguments: methodArguments temporaries: methodTemporaries rootNode: rootNode "<MethodNode>" "^<Sequence of: <TempVarNade>>" + "Top level entry-point for analysing temps within the hierarchy of blocks in the receiver's method. + Answer the (possibly modified) sequence of temp vars. + Need to hoist temps out of macro-optimized blocks into their actual blocks. + Need to note reads and writes to temps from blocks other than their actual blocks to determine + whether blocks can be local (simple slots within a block/method context) or remote (slots in + indirection vectors that are shared between contexts by sharing indirection vectors). + + The algorithm is based on numbering temporary reads and writes and block extents. + The index used for numbering starts at zero and is incremented on every block entry + and block exit. So the following + | a b blk r1 r2 t | + a := 1. b := 2. t := 0. + blk := [ | s | s := a + b. t := t + s]. + r1 := blk value. + b := -100. + r2 := blk value. + r1 -> r2 -> t + is numbered as + method block 0 to: 6: + | a b blk r1 r2 t | + a w@1 := 1. b w@1 := 2. t w@1 := 0. + blk w@5 := [entry@2 | s | + t w@3 := t r@3 + a r@3 + b r@3 + ] exit@4. + r1 w@5 := blk r@5 value. + b w@5 := nil. + r2 w@5 := blk r@5 value. + r1 r@5 -> r2 r@5 -> t r@5 + So: + b and blk cannot be copied because for both there exists a write @5 that follows a + read @4 within block 2 through 4 + t must be remote because there exists a write @3 within block (2 to: 4) + Complications are introduced by optimized blocks. In the following temp is written to + after it is closed over by [ temp ] since the inlined block is executed more than once. + | temp coll | + coll := OrderedCollection new. + 1 to: 5 do: [ :index | + temp := index. + coll add: [ temp ] ]. + self assert: (coll collect: [:ea| ea value]) asArray = #(5 5 5 5 5) + In the following i is local to the block and must be initialized each time around the loop + but if the block is inlined it must be declared at method level. + | col | + col := OrderedCollection new. + 1 to: 3 do: [ :each | | i | i := each. col add: [ i ]. i := i + 1 ]. + self assert: (col collect: [ :each | each value ]) asArray = #(2 3 4)" + self assert: (arguments isEmpty or: [arguments hasEqualElements: methodArguments]). + arguments := methodArguments asArray. "won't change" + self assert: (temporaries isNil or: [temporaries isEmpty or: [temporaries hasEqualElements: methodTemporaries]]). + temporaries := OrderedCollection withAll: methodTemporaries. + + self assert: optimized not. "the top-level block should not be optimized." + self analyseTempsWithin: self rootNode: rootNode assignmentPools: Dictionary new. + + "The top-level block needs to reindex temporaries since analysis may have rearranged them. + This happens when temps are made remote and/or a remote node is added." + temporaries withIndexDo: + [:temp :offsetPlusOne| temp index: arguments size + offsetPlusOne - 1]. + + "Answer the (possibly modified) sequence of temps." + ^temporaries asArray! Item was added: + ----- Method: BlockNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + | effectiveScope blockStart | + effectiveScope := optimized + ifTrue: [actualScopeIfOptimized := scopeBlock] + ifFalse: [self]. + + arguments ifNotNil: + [arguments do: [:temp| temp definingScope: self]]. + temporaries ifNotNil: + [temporaries do: [:temp| temp definingScope: self]]. + + optimized ifFalse: "if optimized this isn't an actual scope" + [rootNode noteBlockEntry: + [:entryNumber| + blockExtent := (blockStart := entryNumber) to: 0]]. + + "Need to enumerate a copy because closure analysis can add a statement + via ifHasRemoteTempNodeEnsureInitializationStatementExists:." + statements copy do: + [:statement| + statement analyseTempsWithin: effectiveScope rootNode: rootNode assignmentPools: assignmentPools]. + + optimized + ifTrue: "if optimized loop need to add nils for any temps read before written" + [optimizedMessageNode isOptimizedLoop ifTrue: + [self nilReadBeforeWrittenTemps]] + ifFalse: "if optimized this isn't an actual scope" + [rootNode noteBlockExit: + [:exitNumber| + blockExtent := blockStart to: exitNumber]]. + + "Now that the analysis is done move any temps that need to be moved." + self postNumberingProcessTempsWithin: effectiveScope rootNode: rootNode. + + "This is simply a nicety for compiler developers..." + temporaries do: + [:temp| + (temp isIndirectTempVector and: [temp name includes: $?]) ifTrue: + [temp name: temp definingScope remoteTempNodeName]]! Item was added: + ----- Method: BlockNode>>arguments (in category 'accessing') ----- + arguments + ^arguments ifNil: [#()]! Item was added: + ----- Method: BlockNode>>arguments: (in category 'accessing') ----- + arguments: argNodes + "Decompile." + + arguments := argNodes! Item was added: + ----- Method: BlockNode>>arguments:statements:returns:from: (in category 'initialize-release') ----- + arguments: argNodes statements: statementsCollection returns: returnBool from: encoder + "Compile." + + arguments := argNodes. + statements := statementsCollection size > 0 + ifTrue: [statementsCollection] + ifFalse: [Array with: NodeNil]. + optimized := false. + returns := returnBool! Item was added: + ----- Method: BlockNode>>block (in category 'accessing') ----- + block + ^ self! Item was added: + ----- Method: BlockNode>>blockExtent (in category 'closure analysis') ----- + blockExtent "^<nil | Interval>" + ^blockExtent! Item was added: + ----- Method: BlockNode>>code (in category 'code generation') ----- + code + + ^statements first code! Item was added: + ----- Method: BlockNode>>computeCopiedValues: (in category 'closure analysis') ----- + computeCopiedValues: rootNode + | referencedValues | + referencedValues := rootNode referencedValuesWithinBlockExtent: blockExtent. + ^(referencedValues reject: [:temp| temp isDefinedWithinBlockExtent: blockExtent]) + asArray sort: ParseNode tempSortBlock! Item was added: + ----- Method: BlockNode>>constructClosureCreationNode: (in category 'code generation') ----- + constructClosureCreationNode: encoder + copiedValues := self computeCopiedValues: encoder rootNode. + ^self ensureClosureCreationNode: encoder! Item was added: + ----- Method: BlockNode>>createBlockLiteral: (in category 'code generation') ----- + createBlockLiteral: encoder + ^self + reindexingLocalsDo: [encoder blockLiteralFor: self] + encoder: encoder! Item was added: + ----- Method: BlockNode>>decompileString (in category 'printing') ----- + decompileString + "Answer a string description of the parse tree whose root is the receiver." + + ^ self decompileText asString + ! Item was added: + ----- Method: BlockNode>>decompileText (in category 'printing') ----- + decompileText + "Answer a text description of the parse tree whose root is the receiver." + + ^ ColoredCodeStream contents: [:strm | self printOn: strm indent: 0] + ! Item was added: + ----- Method: BlockNode>>deoptimize (in category 'closure analysis') ----- + deoptimize + optimized := false. + optimizedMessageNode := nil! Item was added: + ----- Method: BlockNode>>emitCodeExceptLast:encoder: (in category 'code generation') ----- + emitCodeExceptLast: stack encoder: encoder + | position nextToLast | + position := stack position. + nextToLast := statements size - 1. + 1 to: nextToLast do: + [:i | | statement | + statement := statements at: i. + statement emitCodeForEffect: stack encoder: encoder. + self assert: stack position = position].! Item was added: + ----- Method: BlockNode>>emitCodeForEvaluatedClosureValue:encoder: (in category 'code generation') ----- + emitCodeForEvaluatedClosureValue: stack encoder: encoder + | position | + position := stack position. + stack position: arguments size + temporaries size + copiedValues size. + encoder genPushNClosureTemps: temporaries size. + self + reindexingLocalsDo: [self emitCodeForEvaluatedValue: stack encoder: encoder] + encoder: encoder. + self returns ifFalse: + [encoder genReturnTopToCaller. + pc := encoder pc]. + stack position: position! Item was added: + ----- Method: BlockNode>>emitCodeForEvaluatedEffect:encoder: (in category 'code generation') ----- + emitCodeForEvaluatedEffect: stack encoder: encoder + | position | + position := stack position. + self returns + ifTrue: + [self emitCodeForEvaluatedValue: stack encoder: encoder. + stack pop: 1] + ifFalse: + [self emitCodeExceptLast: stack encoder: encoder. + statements last emitCodeForEffect: stack encoder: encoder]. + self assert: stack position = position! Item was added: + ----- Method: BlockNode>>emitCodeForEvaluatedFullClosureValue:encoder: (in category 'code generation') ----- + emitCodeForEvaluatedFullClosureValue: stack encoder: encoder + | position | + position := stack position. + self emitCodeExceptLast: stack encoder: encoder. + (statements last == NodeNil + and: [self returns not]) + ifTrue: + [stack push: 1. + encoder genReturnNilToCaller. + pc := encoder pc] + ifFalse: + [statements last emitCodeForBlockValue: stack encoder: encoder. + self returns ifFalse: + [encoder genReturnTopToCaller. + pc := encoder pc]]. + self assert: stack position - 1 = position! Item was added: + ----- Method: BlockNode>>emitCodeForEvaluatedValue:encoder: (in category 'code generation') ----- + emitCodeForEvaluatedValue: stack encoder: encoder + | position | + position := stack position. + self emitCodeExceptLast: stack encoder: encoder. + statements last emitCodeForBlockValue: stack encoder: encoder. + self assert: stack position - 1 = position! Item was added: + ----- Method: BlockNode>>emitCodeForFullBlockValue:encoder: (in category 'code generation') ----- + emitCodeForFullBlockValue: stack encoder: encoder + copiedValues do: + [:copiedValue| copiedValue emitCodeForValue: stack encoder: encoder]. + closureCreationNode pc: encoder nextPC. + encoder + genPushFullClosure: closureCreationNode index + numCopied: copiedValues size. + stack + pop: copiedValues size; + push: 1! Item was added: + ----- Method: BlockNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + encoder supportsFullBlocks ifTrue: + [^self emitCodeForFullBlockValue: stack encoder: encoder]. + copiedValues do: + [:copiedValue| copiedValue emitCodeForValue: stack encoder: encoder]. + closureCreationNode pc: encoder nextPC. + encoder + genPushClosureCopyNumCopiedValues: copiedValues size + numArgs: arguments size + jumpSize: size. + stack + pop: copiedValues size; + push: 1. + "Emit the body of the block" + self emitCodeForEvaluatedClosureValue: stack encoder: encoder! Item was added: + ----- Method: BlockNode>>ensureClosureCreationNode: (in category 'accessing') ----- + ensureClosureCreationNode: encoder + closureCreationNode ifNil: + [closureCreationNode := LiteralNode new + key: #closureCreationNode + code: (encoder supportsFullBlocks ifTrue: [LdLitType negated])]. + ^closureCreationNode! Item was added: + ----- Method: BlockNode>>ensureNotQuick: (in category 'converting') ----- + ensureNotQuick: encoder + "If the receiver is quick (can be generated as a Quick method, ^self,^inst var or ^ special constant) + make it not so. This is used to create break-pointable versions of quick methods. Answer if the + receiver was quick." + self isQuick ifFalse: + [^false]. + "Making statements size > 1 is sufficient to cause isQuick to answer false (see BlockNode>>isQuick). + N.B. This is a no-op since statements generate via emitCodeForEffect: and VariableNodes have no effect." + statements addFirst: (encoder encodeVariable: 'self'). + ^true! Item was added: + ----- Method: BlockNode>>firstArgument (in category 'accessing') ----- + firstArgument + ^ arguments first! Item was added: + ----- Method: BlockNode>>ifHasRemoteTempNodeEnsureInitializationStatementExists: (in category 'closure analysis') ----- + ifHasRemoteTempNodeEnsureInitializationStatementExists: rootNode + "If a remoteTempNode has been added ensure a statement exists to initialize it." + remoteTempNode ~~ nil ifTrue: + [(statements notEmpty + and: [statements first isAssignmentNode + and: [statements first variable isTemp + and: [statements first variable isIndirectTempVector]]]) + ifTrue: "If this is a decompiled tree, or if a temporary has been added later in + the analysis then there already is a temp vector initialization node." + [(statements first variable ~~ remoteTempNode) ifTrue: + [statements first variable become: remoteTempNode]. + statements first value numElements: remoteTempNode remoteTemps size] + ifFalse: + [statements addFirst: (remoteTempNode nodeToInitialize: rootNode encoder)]].! Item was added: + ----- Method: BlockNode>>isBlockNode (in category 'testing') ----- + isBlockNode + ^true! Item was added: + ----- Method: BlockNode>>isComplex (in category 'testing') ----- + isComplex + + ^statements size > 1 or: [statements size = 1 and: [statements first isComplex]]! Item was added: + ----- Method: BlockNode>>isJust: (in category 'testing') ----- + isJust: node + + returns ifTrue: [^false]. + ^statements size = 1 and: [statements first == node]! Item was added: + ----- Method: BlockNode>>isJustCaseError (in category 'testing') ----- + isJustCaseError + + ^ statements size = 1 and: + [statements first + isMessage: #caseError + receiver: [:r | r==NodeSelf] + arguments: nil]! Item was added: + ----- Method: BlockNode>>isQuick (in category 'testing') ----- + isQuick + ^ statements size = 1 + and: [statements first isVariableReference + or: [statements first isSpecialConstant]]! Item was added: + ----- Method: BlockNode>>localsNodes (in category 'accessing') ----- + localsNodes + "Answer the correctly ordered sequence of local nodes (arguments and temporaries) in the receiver." + ^arguments asArray, copiedValues, temporaries! Item was added: + ----- Method: BlockNode>>makeTemporariesRemovable (in category 'closure analysis') ----- + makeTemporariesRemovable + "Utilities for when we want to remove some temporaries." + + temporaries isArray ifTrue: + [temporaries := temporaries asOrderedCollection].! Item was added: + ----- Method: BlockNode>>nArgsSlot (in category 'accessing') ----- + nArgsSlot + "Private for the Encoder to use in bindArg" + ^nArgsNode! Item was added: + ----- Method: BlockNode>>nArgsSlot: (in category 'accessing') ----- + nArgsSlot: anInteger + "Private for the Encoder to use in bindArg" + nArgsNode := anInteger! Item was added: + ----- Method: BlockNode>>nilReadBeforeWrittenTemps (in category 'closure analysis') ----- + nilReadBeforeWrittenTemps + | visitor readBeforeWritten | + temporaries isEmpty ifTrue: + [^self]. + self accept: (visitor := OptimizedBlockLocalTempReadBeforeWrittenVisitor new). + readBeforeWritten := visitor readBeforeWritten. + temporaries reverseDo: + [:temp| + ((readBeforeWritten includes: temp) + and: [temp isRemote not]) ifTrue: + [statements addFirst: (AssignmentNode new variable: temp value: NodeNil)]]! Item was added: + ----- Method: BlockNode>>noteOptimizedIn: (in category 'closure analysis') ----- + noteOptimizedIn: anOptimizedMessageNode + optimized := true. + optimizedMessageNode := anOptimizedMessageNode! Item was added: + ----- Method: BlockNode>>noteSourceRangeStart:end:encoder: (in category 'initialize-release') ----- + noteSourceRangeStart: start end: end encoder: encoder + "Note two source ranges for this node. One is for the debugger + and is of the last expression, the result of the block. One is for + source analysis and is for the entire block." + encoder + noteSourceRange: (start to: end) + forNode: (self ensureClosureCreationNode: encoder). + startOfLastStatement + ifNil: + [encoder + noteSourceRange: (start to: end) + forNode: self] + ifNotNil: + [encoder + noteSourceRange: (startOfLastStatement to: end - 1) + forNode: self]! Item was added: + ----- Method: BlockNode>>numberOfArguments (in category 'accessing') ----- + numberOfArguments + + ^arguments size! Item was added: + ----- Method: BlockNode>>optimized (in category 'accessing') ----- + optimized + ^optimized! Item was added: + ----- Method: BlockNode>>optimizedBlockHoistTempsInto: (in category 'closure analysis') ----- + optimizedBlockHoistTempsInto: scopeBlock "<BlockNode>" + "This is a No-op for all nodes except non-optimized BlockNodes." + "Let's assume the special > 0 guard in MessageNode>>analyseTempsWithin:forValue:encoder: is correct. + Then we can simply hoist our temps up." + self assert: (arguments isNil or: [arguments size <= 1]). + (arguments notNil and: [arguments notEmpty]) ifTrue: + [scopeBlock addHoistedTemps: arguments. + arguments := #()]. + temporaries notEmpty ifTrue: + [scopeBlock addHoistedTemps: temporaries. + temporaries := #()]! Item was added: + ----- Method: BlockNode>>postNumberingProcessTempsWithin:rootNode: (in category 'closure analysis') ----- + postNumberingProcessTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" + "A temp can be local (and copied) if it is not written to after it is captured. + A temp cannot be local if it is written to remotely. + Need to enumerate a copy of the temporaries because any temps becoming remote + will be removed from temporaries in analyseClosure: (and a single remote temp node + will get added)" + temporaries copy do: + [:each| + each isIndirectTempVector ifFalse: + [each analyseClosure: rootNode]]. + + "If this is an optimized node we need to hoist temporaries up into the relevant block scope." + optimized ifTrue: + [self optimizedBlockHoistTempsInto: scopeBlock]. + + "Now we may have added a remoteTempNode. So we need a statement to initialize it." + self ifHasRemoteTempNodeEnsureInitializationStatementExists: rootNode. + + "Now add all arguments and locals to the pool so that copiedValues can be computed during sizing." + rootNode + addLocalsToPool: arguments; + addLocalsToPool: temporaries! Item was added: + ----- Method: BlockNode>>printArgumentsOn:indent: (in category 'printing') ----- + printArgumentsOn: aStream indent: level + arguments size = 0 ifTrue: [^ self]. + arguments do: + [:arg | aStream nextPut: $:; nextPutAll: arg key; space]. + aStream nextPut: $|; space. + "If >0 args and >1 statement, put all statements on separate lines" + statements size > 1 ifTrue: + [aStream crtab: level]! Item was added: + ----- Method: BlockNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + + "statements size <= 1 ifFalse: [aStream crtab: level]." + aStream nextPut: $[. + self printArgumentsOn: aStream indent: level. + (self printTemporaries: temporaries on: aStream doPrior: []) ifTrue: + ["If >0 temps and >1 statement, put all statements on separate lines" + statements size > 1 + ifTrue: [aStream crtab: level] + ifFalse: [aStream space]]. + self printStatementsOn: aStream indent: level. + aStream nextPut: $]! Item was added: + ----- Method: BlockNode>>printStatementsOn:indent: (in category 'printing') ----- + printStatementsOn: aStream indent: levelOrZero + | len shown thisStatement level | + level := 1 max: levelOrZero. + comment ifNotNil: + [self printCommentOn: aStream indent: level. + aStream crtab: level]. + len := shown := statements size. + (levelOrZero = 0 "top level" and: [statements last isReturnSelf]) + ifTrue: [shown := 1 max: shown - 1] + ifFalse: ["should a trailing nil be printed or not? Not if it is an implicit result, not if the last statement answers nil." + ((arguments size > 0 and: [len = 0]) + or: [(statements at: len) == NodeNil + and: [len = 1 + or: [len > 1 + and: [(statements at: len - 1) isMessageNode + and: [(statements at: len - 1) isNilIf + or: [(statements at: len - 1) isOptimizedWhileLoop]]]]]]) + ifTrue: [shown := shown - 1]]. + 1 to: shown do: + [:i | + thisStatement := statements at: i. + thisStatement printOn: aStream indent: level. + i < shown ifTrue: [aStream nextPut: $.; crtab: level]. + (thisStatement comment ~~ nil and: [thisStatement comment size > 0]) + ifTrue: + [i = shown ifTrue: [aStream crtab: level]. + thisStatement printCommentOn: aStream indent: level. + i < shown ifTrue: [aStream crtab: level]]]! Item was added: + ----- Method: BlockNode>>printTemporaries:on:doPrior: (in category 'printing') ----- + printTemporaries: tempSequence on: aStream doPrior: aBlock + "Print any in-scope temporaries. If there are any evaluate aBlock + prior to printing. Answer whether any temporaries were printed." + | tempStream seen | + tempSequence ifNil: + [^false]. + tempStream := (String new: 16) writeStream. + "This is for the decompiler which canmot work out which optimized block a particular temp is + local to and hence may produce diplicates as in + expr ifTrue: [| aTemp | ...] ifFalse: [| aTemp | ...]" + seen := Set new. + tempSequence do: + [:tempNode | + tempNode isIndirectTempVector + ifTrue: + [tempNode remoteTemps do: + [:tempVariableNode| + (tempVariableNode scope >= 0 + and: [ + "This is for the deocmpiler which may create a block arg when converting + a ifTrue:ifFalse: into a ifNil:ifNotNil: but won't remove it from temporaries" + tempVariableNode isBlockArg not + and: [(seen includes: tempNode key) not]]) ifTrue: + [tempStream space; nextPutAll: (seen add: tempVariableNode key)]]] + ifFalse: + [(tempNode scope >= -1 + and: ["This is for the decompiler which may create a block arg when converting + a while into a to:do: but won't remove it from temporaries" + tempNode isBlockArg not + and: [(seen includes: tempNode key) not]]) ifTrue: + [tempStream space; nextPutAll: (seen add: tempNode key)]]]. + tempStream position = 0 ifTrue: + [^false]. + aBlock value. + aStream nextPut: $|; nextPutAll: tempStream contents; space; nextPut: $|. + ^true! Item was added: + ----- Method: BlockNode>>printWithClosureAnalysisArgumentsOn:indent: (in category 'printing') ----- + printWithClosureAnalysisArgumentsOn: aStream indent: level + arguments size = 0 ifTrue: [^self]. + arguments do: + [:tempNode | + aStream space; nextPut: $:. + tempNode printDefinitionForClosureAnalysisOn: aStream]. + aStream nextPut: $|; space. + "If >0 args and >1 statement, put all statements on separate lines" + statements size > 1 ifTrue: + [aStream crtab: level]! Item was added: + ----- Method: BlockNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + aStream nextPut: $[. + blockExtent ifNotNil: [aStream print: blockExtent]. + self printWithClosureAnalysisArgumentsOn: aStream indent: level. + self printWithClosureAnalysisTemporariesOn: aStream indent: level. + self printWithClosureAnalysisStatementsOn: aStream indent: level. + aStream nextPut: $]! Item was added: + ----- Method: BlockNode>>printWithClosureAnalysisStatementsOn:indent: (in category 'printing') ----- + printWithClosureAnalysisStatementsOn: aStream indent: levelOrZero + | len shown thisStatement level | + level := 1 max: levelOrZero. + comment == nil + ifFalse: + [self printCommentOn: aStream indent: level. + aStream crtab: level]. + len := shown := statements size. + (levelOrZero = 0 "top level" and: [statements last isReturnSelf]) + ifTrue: [shown := 1 max: shown - 1] + ifFalse: [(len = 1 and: [((statements at: 1) == NodeNil) & (arguments size = 0)]) + ifTrue: [shown := shown - 1]]. + 1 to: shown do: + [:i | + thisStatement := statements at: i. + thisStatement printWithClosureAnalysisOn: aStream indent: level. + i < shown ifTrue: [aStream nextPut: $.; crtab: level]. + (thisStatement comment ~~ nil and: [thisStatement comment size > 0]) + ifTrue: + [i = shown ifTrue: [aStream crtab: level]. + thisStatement printCommentOn: aStream indent: level. + i < shown ifTrue: [aStream crtab: level]]]! Item was added: + ----- Method: BlockNode>>printWithClosureAnalysisTemporariesOn:indent: (in category 'printing') ----- + printWithClosureAnalysisTemporariesOn: aStream indent: level + + (temporaries == nil or: [temporaries size = 0]) ifFalse: + [aStream nextPut: $|. + temporaries do: + [:tempNode | + aStream space. + tempNode printDefinitionForClosureAnalysisOn: aStream]. + aStream nextPutAll: ' | '. + "If >0 args and >1 statement, put all statements on separate lines" + statements size > 1 ifTrue: [aStream crtab: level]]! Item was added: + ----- Method: BlockNode>>reindexingLocalsDo:encoder: (in category 'closure analysis') ----- + reindexingLocalsDo: aBlock encoder: encoderOrNil + "Evaluate aBlock wih arguments, temporaries and copiedValues reindexed for + their positions within the receiver's block, restoring the correct indices afterwards. + If encoder is not nil remember the temps for this block's extent." + | tempIndices result tempsToReindex | + self assert: copiedValues notNil. + tempsToReindex := arguments asArray, copiedValues, temporaries. + tempIndices := tempsToReindex collect: [:temp| temp index]. + tempsToReindex withIndexDo: + [:temp :newIndex| temp index: newIndex - 1. self assert: temp index + 1 = newIndex]. + encoderOrNil ifNotNil: + [encoderOrNil noteBlockExtent: blockExtent hasLocals: tempsToReindex]. + result := aBlock ensure: + ["Horribly pragmatic hack. The copiedValues will have completely + unrelated indices within the closure method and sub-method. + Avoiding the effort of rebinding temps in the inner scope simply + update the indices to their correct ones during the generation of + the closure method and restore the indices immedately there-after." + tempsToReindex with: tempIndices do: + [:temp :oldIndex| temp index: oldIndex. self assert: temp index = oldIndex]]. + ^result! Item was added: + ----- Method: BlockNode>>remoteTempNodeName (in category 'closure analysis') ----- + remoteTempNodeName + "Answer a useful name for a RemoteTempVectorNode in the receiver." + | prefix scope extent | + prefix := actualScopeIfOptimized ifNil: ['<'] ifNotNil: [ '<...']. + scope := self. + [extent := scope blockExtent. + extent == nil + and: [scope actualScope ~~ scope]] whileTrue: + [scope := scope actualScope]. + ^extent + ifNil: [prefix, '?-?>'] + ifNotNil: + [prefix, extent first printString, '-', + (extent last isZero + ifTrue: ['?'] + ifFalse: [extent last printString]), '>']! Item was added: + ----- Method: BlockNode>>removeTempNode:ifAbsent: (in category 'closure analysis') ----- + removeTempNode: aTempVariableNode ifAbsent: aBlock + "Utilities for when we want to remove some temporaries." + + self makeTemporariesRemovable. + ^temporaries remove: aTempVariableNode ifAbsent: aBlock + ! Item was added: + ----- Method: BlockNode>>returnLast (in category 'accessing') ----- + returnLast + + self returns + ifFalse: + [returns := true. + statements at: statements size put: statements last asReturnNode]! Item was added: + ----- Method: BlockNode>>returnNilIfNoOther (in category 'accessing') ----- + returnNilIfNoOther + + self returns + ifFalse: + [statements last == NodeNil ifFalse: [statements add: NodeNil]. + self returnLast]! Item was added: + ----- Method: BlockNode>>returnSelfIfNoOther: (in category 'accessing') ----- + returnSelfIfNoOther: encoder + + self returns ifTrue:[^self]. + statements last == NodeSelf ifFalse: [ + statements := statements copyWith: (encoder encodeVariable: 'self'). + ]. + self returnLast. + ! Item was added: + ----- Method: BlockNode>>returns (in category 'testing') ----- + returns + + ^returns or: [statements last isReturningIf]! Item was added: + ----- Method: BlockNode>>sizeCodeExceptLast: (in category 'code generation') ----- + sizeCodeExceptLast: encoder + | codeSize | + codeSize := 0. + 1 to: statements size - 1 do: + [:i | | statement | + statement := statements at: i. + codeSize := codeSize + (statement sizeCodeForEffect: encoder)]. + ^codeSize! Item was added: + ----- Method: BlockNode>>sizeCodeForEvaluatedClosureValue: (in category 'code generation') ----- + sizeCodeForEvaluatedClosureValue: encoder + "The closure value primitives push the arguments and the copied values. + The compiler guarantees that any copied values come before all local temps. + So on closure activation we only need to push nils for the remaining temporaries." + ^(encoder sizePushNClosureTemps: temporaries size) + + (self + reindexingLocalsDo: [self sizeCodeForEvaluatedValue: encoder] + encoder: nil "don't store temps yet") + + (self returns ifTrue: [0] ifFalse: [encoder sizeReturnTopToCaller])! Item was added: + ----- Method: BlockNode>>sizeCodeForEvaluatedEffect: (in category 'code generation') ----- + sizeCodeForEvaluatedEffect: encoder + + ^self returns + ifTrue: [self sizeCodeForEvaluatedValue: encoder] + ifFalse: [(self sizeCodeExceptLast: encoder) + + (statements last sizeCodeForEffect: encoder)]! Item was added: + ----- Method: BlockNode>>sizeCodeForEvaluatedFullClosureValue: (in category 'code generation') ----- + sizeCodeForEvaluatedFullClosureValue: encoder + "The closure value primitives push the arguments and the copied values. + The compiler guarantees that any copied values come before all local temps. + So on full closure activation we need do nothing." + (statements last == NodeNil + and: [self returns not]) ifTrue: + [^(self sizeCodeExceptLast: encoder) + + encoder sizeReturnNilToCaller]. + ^(self sizeCodeForEvaluatedValue: encoder) + + (self returns ifTrue: [0] ifFalse: [encoder sizeReturnTopToCaller])! Item was added: + ----- Method: BlockNode>>sizeCodeForEvaluatedValue: (in category 'code generation') ----- + sizeCodeForEvaluatedValue: encoder + + ^(self sizeCodeExceptLast: encoder) + + (statements last sizeCodeForBlockValue: encoder)! Item was added: + ----- Method: BlockNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + "Compute the size for the creation of the block and its code." + copiedValues := self computeCopiedValues: encoder rootNode. + self ensureClosureCreationNode: encoder. + encoder supportsFullBlocks ifTrue: + [^(copiedValues inject: 0 into: [:sum :node| sum + (node sizeCodeForValue: encoder)]) + + (encoder + sizePushFullClosure: + (closureCreationNode + key: (self createBlockLiteral: encoder); + reserve: encoder; + index) + numCopied: copiedValues size)]. + "Remember size of body for emit time so we know the size of the jump around it." + size := self sizeCodeForEvaluatedClosureValue: encoder. + ^(copiedValues inject: 0 into: [:sum :node| sum + (node sizeCodeForValue: encoder)]) + + (encoder sizePushClosureCopyNumCopiedValues: copiedValues size numArgs: arguments size jumpSize: size) + + size! Item was added: + ----- Method: BlockNode>>startOfLastStatement (in category 'accessing') ----- + startOfLastStatement + ^startOfLastStatement! Item was added: + ----- Method: BlockNode>>startOfLastStatement: (in category 'accessing') ----- + startOfLastStatement: anInteger + "Note the source index of the start of the last full statement. The + last full statement is the value answered by a block and hence the + expression the debugger should display as the value of the block." + startOfLastStatement := anInteger! Item was added: + ----- Method: BlockNode>>statements (in category 'accessing') ----- + statements + ^statements! Item was added: + ----- Method: BlockNode>>statements: (in category 'accessing') ----- + statements: val + statements := val! Item was added: + ----- Method: BlockNode>>statements:returns: (in category 'initialize-release') ----- + statements: statementsCollection returns: returnBool + "Decompile." + + | returnLast | + returnLast := returnBool. + returns := false. + statements := + (statementsCollection size > 1 + and: [(statementsCollection at: statementsCollection size - 1) + isReturningIf]) + ifTrue: + [returnLast := false. + statementsCollection allButLast] + ifFalse: [statementsCollection size = 0 + ifTrue: [Array with: NodeNil] + ifFalse: [statementsCollection]]. + arguments := #(). + temporaries := #(). + optimized := false. + returnLast ifTrue: [self returnLast]! Item was added: + ----- Method: BlockNode>>temporaries (in category 'accessing') ----- + temporaries + ^temporaries ifNil: [#()]! Item was added: + ----- Method: BlockNode>>temporaries: (in category 'accessing') ----- + temporaries: aCollection + temporaries := aCollection! Item was added: + ----- Method: BlockNode>>tempsMark (in category 'accessing') ----- + tempsMark + ^tempsMark! Item was added: + ----- Method: BlockNode>>tempsMark: (in category 'accessing') ----- + tempsMark: anInteger + tempsMark := anInteger! Item was added: + InstructionClient subclass: #BlockStartLocator + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !BlockStartLocator commentStamp: 'eem 1/11/2018 08:32' prior: 0! + A BlockStartLocator is a scanner that locates the block creation bytecodes in a method. For block creation bytecodes it answers information salient to the kind of block being created, and for all other bytecodes simply answers itself. + + Instance Variables + ! Item was added: + ----- Method: BlockStartLocator>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') ----- + pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize + "Answer the size of the block" + ^blockSize! Item was added: + ----- Method: BlockStartLocator>>pushFullClosure:numCopied: (in category 'instruction decoding') ----- + pushFullClosure: aCompiledBlock numCopied: numCopied + "Answer the block method" + ^aCompiledBlock! Item was added: + ParseNode subclass: #BraceNode + instanceVariableNames: 'elements sourceLocations emitNode' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !BraceNode commentStamp: '<historical>' prior: 0! + Used for compiling and decompiling brace constructs. + + These now compile into either a fast short form for 4 elements or less: + Array braceWith: a with: b ... + or a long form of indefinfite length: + (Array braceStream: N) nextPut: a; nextPut: b; ...; braceArray. + + The erstwhile brace assignment form is no longer supported.! Item was added: + ----- Method: BraceNode class>>example (in category 'examples') ----- + example + "Test the {a. b. c} syntax." + + | x | + x := {1. {2. 3}. 4}. + ^ {x first. x second first. x second last. x last. 5} as: Set + + "BraceNode example Set (0 1 2 3 4 5 )" + ! Item was added: + ----- Method: BraceNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitBraceNode: self! Item was added: + ----- Method: BraceNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + elements do: + [:node| + node analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools]! Item was added: + ----- Method: BraceNode>>blockAssociationCheck: (in category 'testing') ----- + blockAssociationCheck: encoder + "If all elements are MessageNodes of the form [block]->[block], and there is at + least one element, answer true. + Otherwise, notify encoder of an error." + + elements size = 0 + ifTrue: [^encoder notify: 'At least one case required']. + elements with: sourceLocations do: + [:x :loc | + (x isMessage: #-> + receiver: + [:rcvr | + rcvr isBlockNode and: [rcvr numberOfArguments = 0]] + arguments: + [:arg | + arg isBlockNode and: [arg numberOfArguments = 0]]) + ifFalse: + [^encoder notify: 'Association between 0-argument blocks required' at: loc]]. + ^true! Item was added: + ----- Method: BraceNode>>casesForwardDo: (in category 'enumerating') ----- + casesForwardDo: aBlock + "For each case in forward order, evaluate aBlock with three arguments: + the key block, the value block, and whether it is the last case." + + | numCases case | + 1 to: (numCases := elements size) do: + [:i | + case := elements at: i. + aBlock value: case receiver value: case arguments first value: i=numCases]! Item was added: + ----- Method: BraceNode>>casesReverseDo: (in category 'enumerating') ----- + casesReverseDo: aBlock + "For each case in reverse order, evaluate aBlock with three arguments: + the key block, the value block, and whether it is the last case." + + | numCases case | + (numCases := elements size) to: 1 by: -1 do: + [:i | + case := elements at: i. + aBlock value: case receiver value: case arguments first value: i=numCases]! Item was added: + ----- Method: BraceNode>>deoptimize (in category 'closure analysis') ----- + deoptimize + "Deoptimize the blocks in a caseOf:[otherwise:] that is being used in a cascade." + elements do: + [:aMessage| + self assert: aMessage selector key == #->. + aMessage receiver deoptimize. + aMessage arguments first deoptimize]! Item was added: + ----- Method: BraceNode>>elements (in category 'code generation') ----- + elements + ^elements! Item was added: + ----- Method: BraceNode>>elements: (in category 'initialize-release') ----- + elements: collection + "Decompile." + + elements := collection! Item was added: + ----- Method: BraceNode>>elements:sourceLocations: (in category 'initialize-release') ----- + elements: collection sourceLocations: locations + "Compile." + + elements := collection. + sourceLocations := locations! Item was added: + ----- Method: BraceNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + "Hack; when sizing we have no way of knowing how much stack space is available." + elements size <= self maxElementsForConsArray ifTrue: + [elements do: [:node| node emitCodeForValue: stack encoder: encoder]. + encoder genPushConsArray: elements size. + stack + pop: elements size; + push: 1. + ^self]. + ^emitNode emitCodeForValue: stack encoder: encoder! Item was added: + ----- Method: BraceNode>>isBraceNode (in category 'testing') ----- + isBraceNode + ^true! Item was added: + ----- Method: BraceNode>>matchBraceStreamReceiver:messages: (in category 'initialize-release') ----- + matchBraceStreamReceiver: receiver messages: messages + + ((receiver isMessage: #braceStream: receiver: nil arguments: [:arg | arg isConstantNumber]) + and: [messages last isMessage: #braceArray receiver: nil arguments: nil]) + ifFalse: [^ nil "no match"]. + + "Appears to be a long form brace construct" + self elements: (messages allButLast collect: + [:msg | (msg isMessage: #nextPut: receiver: nil arguments: nil) + ifFalse: [^ nil "not a brace element"]. + msg arguments first])! Item was added: + ----- Method: BraceNode>>maxElementsForConsArray (in category 'code generation') ----- + maxElementsForConsArray + "Hack; we have no way of knowing how much stack space is available during sizing" + ^8! Item was added: + ----- Method: BraceNode>>numElements (in category 'testing') ----- + numElements + + ^ elements size! Item was added: + ----- Method: BraceNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + + aStream nextPut: ${. + 1 to: elements size do: + [:i | (elements at: i) printOn: aStream indent: level. + i < elements size ifTrue: [aStream nextPutAll: '. ']]. + aStream nextPut: $}! Item was added: + ----- Method: BraceNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + + aStream nextPut: ${. + 1 to: elements size do: + [:i | (elements at: i) printWithClosureAnalysisOn: aStream indent: level. + i < elements size ifTrue: [aStream nextPutAll: '. ']]. + aStream nextPut: $}! Item was added: + ----- Method: BraceNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + + "Hack; we have no way of knowing how much stack space is available." + elements size <= self maxElementsForConsArray ifTrue: + [^(elements inject: 0 into: [:sum :node| sum + (node sizeCodeForValue: encoder)]) + + (encoder sizePushConsArray: elements size)]. + "Long form: (Array braceStream: N) nextPut: a; nextPut: b; ...; braceArray" + emitNode := CascadeNode new + receiver: (MessageNode new + receiver: (encoder encodeVariable: #Array) + selector: #braceStream: + arguments: {encoder encodeLiteral: elements size} + precedence: 3 from: encoder) + messages: ((elements collect: [:elt | + MessageNode new + receiver: nil + selector: #nextPut: + arguments: {elt} + precedence: 3 + from: encoder]) + copyWith: (MessageNode new + receiver: nil + selector: #braceArray + arguments: #() + precedence: 1 + from: encoder)). + ^emitNode sizeCodeForValue: encoder! Item was added: + Encoder subclass: #BytecodeEncoder + instanceVariableNames: 'stream position rootNode blockExtentsToLocals blockMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !BytecodeEncoder commentStamp: 'eem 1/10/2018 17:28' prior: 0! + I am an abstract superclass for different bytecode set encoders. Subclasses inherit the literal management of Encoder and encapsulate the mapping of opcodes to specific bytecodes. + + Instance Variables + blockExtentsToLocals: <Dictionary from: Interval to: (Array of: String)> + blockMethod: <CompiledBlock> + position: <Integer> + rootNode: <MethodNode> + stream: <WriteStream | BytecodeEncoder> + + blockExtentsToLocals + - is a map from block extent to the sequence of temps defined in the block with that extent + + blockMethod + - the compiled block being generated in generateBlockMethodOfClass:trailer:from: + + position + - used to size bytecodes by having the receiver masquerade as a stream during sizeOpcodeSelector:withArguments: + + rootNode + - the MethodNode for the method being generated + + stream + - during bytecode sizing this is the receiver. During bytecode generation this is the WriteStream on the method! Item was added: + ----- Method: BytecodeEncoder class>>bindingReadScanBlockFor:using: (in category 'compiled method support') ----- + bindingReadScanBlockFor: litVarIndex using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for reads of the value of the binding with zero-relative index litVarIndex. + N.B. Don't assume the compiler uses the most compact encoding available." + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>bindingWriteScanBlockFor:using: (in category 'compiled method support') ----- + bindingWriteScanBlockFor: litVarIndex using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for writes of the value of the binding with zero-relative index litVarIndex. + N.B. Don't assume the compiler uses the most compact encoding available." + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>blockMethodOrNilFor:in:at: (in category 'instruction stream support') ----- + blockMethodOrNilFor: anInstructionStream in: method at: pc + "If anInstructionStream is at a block creation bytecode then answer the block's + CompiledBlock, otherwise answer nil. + Subclasses override as appropriate." + + ^nil! Item was added: + ----- Method: BytecodeEncoder class>>bytecodeSetName (in category 'compiled method support') ----- + bytecodeSetName + ^self name copyReplaceAll: 'EncoderFor' with: ''! Item was added: + ----- Method: BytecodeEncoder class>>bytecodeSize: (in category 'instruction stream support') ----- + bytecodeSize: aByte + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>callPrimitiveCode (in category 'bytecode decoding') ----- + callPrimitiveCode + "Answer the call primitive bytecode, if it exists in the encoder's byetcode set, or nil if not." + ^nil! Item was added: + ----- Method: BytecodeEncoder class>>canBeSpecialLiteral: (in category 'testing') ----- + canBeSpecialLiteral: aLiteral + "This check can be used to prevent unnecessary use of #scanBlockOrNilForLiteral:. For performance, this method summarizes specializations from all known bytecode encoders. It is not meant to be refined per bytecode encoder." + + aLiteral isVariableBinding ifTrue: [^false]. "a common case; don't waste time analysing..." + + aLiteral isSymbol ifTrue: [^ Smalltalk specialSelectors identityIncludes: aLiteral]. + aLiteral isCharacter ifTrue: [^ aLiteral asInteger <= 65535]. + aLiteral isInteger ifTrue: [^ aLiteral between: -32768 and: 32767]. + + aLiteral == true ifTrue: [^ true]. + aLiteral == false ifTrue: [^ true]. + aLiteral == nil ifTrue: [^ true]. + + ^ false! Item was added: + ----- Method: BytecodeEncoder class>>createClosureCode (in category 'bytecode decoding') ----- + createClosureCode + "Answer the create closure bytecode, if it exists in the encoder's bytecode set, or nil if not." + ^nil! Item was added: + ----- Method: BytecodeEncoder class>>createClosureScanBlock (in category 'compiled method support') ----- + createClosureScanBlock + "Answer a block argument for InstructionStream>>scanFor: that answers true + for block closure creation bytecodes." + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>extensionsAt:in:into: (in category 'instruction stream support') ----- + extensionsAt: pc in: aCompiledMethod into: trinaryBlock + "If the bytecode at pc is an extension then evaluate aTrinaryBlock + with the values of extA and extB and number of extension *bytes*. + If the bytecode at pc is not an extension then evaluate with 0, 0, 0." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>extensionsFor:in:into: (in category 'instruction stream support') ----- + extensionsFor: pc in: aCompiledMethod into: trinaryBlock + "If the bytecode at pc is an extension, or if the bytecode at pc is preceded by extensions, + then evaluate aTrinaryBlock with the values of extA and extB and number of extension *bytes*. + If the bytecode at pc is neither an extension or extended then evaluate with 0, 0, 0." + + | prevPC | + "If there is what appears to be an extension bytecode before this bytecode + then scan for the previous pc to confirm." + (pc - 2 >= aCompiledMethod initialPC + and: [self isExtension: (aCompiledMethod at: pc - 2)]) ifTrue: + [prevPC := aCompiledMethod pcPreviousTo: pc. + (self nonExtensionPcAt: prevPC in: aCompiledMethod) = pc ifTrue: + [^self extensionsAt: prevPC in: aCompiledMethod into: trinaryBlock]]. + ^self extensionsAt: pc in: aCompiledMethod into: trinaryBlock! Item was added: + ----- Method: BytecodeEncoder class>>instVarReadScanBlockFor:using: (in category 'compiled method support') ----- + instVarReadScanBlockFor: varIndexCode using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for reads of the inst var with zero-relative index varIndexCode. + N.B. Don't assume the compiler uses the most compact encoding available." + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>instVarWriteScanBlockFor:using: (in category 'compiled method support') ----- + instVarWriteScanBlockFor: varIndexCode using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for writes of the inst var with zero-relative index varIndexCode. + N.B. Don't assume the compiler uses the most compact encoding available." + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>interpretJumpIfCondIn: (in category 'instruction stream support') ----- + interpretJumpIfCondIn: anInstructionStream + "Double-dispatch through the encoder to select the correct conditional jump decoder for the instruction set." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>interpretJumpIn: (in category 'instruction stream support') ----- + interpretJumpIn: anInstructionStream + "Double-dispatch through the encoder to select the correct jump decoder for the instruction set." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>interpretNextInstructionFor:in: (in category 'instruction stream support') ----- + interpretNextInstructionFor: aClient in: anInstructionStream + "Double-dispatch instruction interpretation through the encoder + to select the correct instruction set decoder." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isBlockReturnAt:in: (in category 'instruction stream support') ----- + isBlockReturnAt: pc in: method + "Answer whether the bytecode at pc is a return from block." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isBranchIfFalseAt:in: (in category 'instruction stream support') ----- + isBranchIfFalseAt: pc in: method + "Answer whether the bytecode at pc is a conditional branch-if-false." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isBranchIfTrueAt:in: (in category 'instruction stream support') ----- + isBranchIfTrueAt: pc in: method + "Answer whether the bytecode at pc is a conditional branch-if-true." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isExtension: (in category 'instruction stream support') ----- + isExtension: bytecode + "Answer if the bytecode is an extension bytecode, i.e. one that extends + the range of the following bytecode." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isJumpAt:in: (in category 'instruction stream support') ----- + isJumpAt: pc in: method + "Answer whether the bytecode at pc is an (unconditional) jump." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isJustPopAt:in: (in category 'instruction stream support') ----- + isJustPopAt: pc in: method + "Answer whether the bytecode at pc is a pop." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isNonSyntheticStoreAt:in:for: (in category 'instruction stream support') ----- + isNonSyntheticStoreAt: pc in: method for: anInstructionStream + "Answer whether the bytecode at pc is a store or store-pop into an explicit variable. + This eliminates stores into indirect temp vectors, which implement mutable closed-over + variables in the the closure implementation, and hence stores into temp vectors are not real stores." + + ^(self isStoreAt: pc in: method) + and: [(self isSyntheticStoreAt: pc in: method for: anInstructionStream) not]! Item was added: + ----- Method: BytecodeEncoder class>>isRealSendAt:in: (in category 'instruction stream support') ----- + isRealSendAt: pc in: method + "Answer whether the bytecode at pc is a real message-send, not blockCopy:." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isReturnAt:in: (in category 'instruction stream support') ----- + isReturnAt: pc in: method + "Answer whether the bytecode at pc is a return." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isReturnSelfFromMethodAt:in: (in category 'instruction stream support') ----- + isReturnSelfFromMethodAt: pc in: method + "Answer whether the bytecode at pc is a return self from method." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isReturnTopFromMethodAt:in: (in category 'instruction stream support') ----- + isReturnTopFromMethodAt: pc in: method + "Answer whether the bytecode at pc is a return stack top from method." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isSendAt:in: (in category 'instruction stream support') ----- + isSendAt: pc in: method + "Answer whether the bytecode at pc is a message-send." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isStoreAt:in: (in category 'instruction stream support') ----- + isStoreAt: pc in: method + "Answer whether the bytecode at pc is a store or store-pop." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isStorePopAt:in: (in category 'instruction stream support') ----- + isStorePopAt: pc in: method + "Answer whether the bytecode at pc is a store-pop." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>isSyntheticStoreAt:in:for: (in category 'instruction stream support') ----- + isSyntheticStoreAt: pc in: method for: anInstructionStream + "Answer whether the bytecode at pc is a store or store-pop of an indirect temp vector, + which implement mutable closed-over variables in the the closure implementation. + Stores into temp vectors are not real stores." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>markerOrNilFor: (in category 'compiled method support') ----- + markerOrNilFor: aMethod + "If aMethod is a marker method, answer the symbol used to mark it. Otherwise + answer nil. What is a marker method? It is method with body like + 'self subclassResponsibility' or '^ self subclassResponsibility' + used to indicate ('mark') a special property. + + Marker methods compile to two bytecode forms, this: + self + send: <literal 1> + pop + returnSelf + or this: + self + send: <literal 1> + returnTop" + ^self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>method:readsField: (in category 'scanning') ----- + method: method readsField: varIndex + "Answer if method loads the instance variable indexed by varIndex." + ^self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>method:writesField: (in category 'scanning') ----- + method: method writesField: varIndex + "Answer if method stores into the instance variable indexed by varIndex." + ^self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>nonExtensionBytecodeAt:in: (in category 'instruction stream support') ----- + nonExtensionBytecodeAt: pc in: method + "Answer the actual bytecode at pc in method, skipping past any preceding extensions." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>nonExtensionPcAt:in: (in category 'instruction stream support') ----- + nonExtensionPcAt: pc in: method + "Answer the pc of the actual bytecode at pc in method, skipping past any preceding extensions." + | thePC bytecode | + thePC := pc. + [self isExtension: (bytecode := method at: thePC)] whileTrue: + [thePC := thePC + (self bytecodeSize: bytecode)]. + ^thePC! Item was added: + ----- Method: BytecodeEncoder class>>pcFollowingBlockAt:in: (in category 'bytecode decoding') ----- + pcFollowingBlockAt: pc in: method + "Assuming the pc is that of a block creation bytecode, answer the pc immediately following the block, + i.e. the next pc after the block creation." + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>pcOfBlockCreationBytecodeForBlockStartingAt:in: (in category 'bytecode decoding') ----- + pcOfBlockCreationBytecodeForBlockStartingAt: startpc in: method + "Answer the pc of the push closure bytecode whose block starts at startpc in method." + ^self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>pcPreviousTo:in:for: (in category 'bytecode decoding') ----- + pcPreviousTo: thePC in: method for: anInstructionStreamOrContext + "Answer the pc of the bytecode before the bytecode at thePC. + Unlike CompiledMethod>>pcPreviousTo:, this version answers nil for + the first bytecode of an embedded block, and answers the pc of the + block creation bytecode for a bytecode following an embedded block." + | pc nextPc prevPc byte createClosureCode | + thePC > method endPC ifTrue: + [^method endPC]. + pc := method initialPC. + "We could save time by scanning from the block creation bytecode of an embedded block, + using the following, but it saves less time than it loses in additional tests." + "(anInstructionStreamOrContext isContext + and: [anInstructionStreamOrContext isClosureContext + and: [(nextPc := anInstructionStreamOrContext startpc) > pc]]) ifTrue: + [pc := self pcOfBlockCreationBytecodeForBlockStartingAt: nextPc in: method]." + createClosureCode := self createClosureCode. + [pc < thePC] whileTrue: + [byte := method at: (prevPc := pc). + [pc := createClosureCode = byte + ifTrue: + [nextPc := self pcFollowingBlockAt: pc in: method. + nextPc = thePC ifTrue: "first bytecode following block" + [^prevPc]. + nextPc > thePC + ifTrue: + [pc + (self bytecodeSize: byte) = thePC ifTrue: "first bytecode of block" + [^nil]. + pc + (self bytecodeSize: byte)] + ifFalse: [nextPc]] + ifFalse: [pc + (self bytecodeSize: byte)]. + self isExtension: byte] whileTrue: + [byte := method at: pc]]. + ^prevPc + + "Here's code to measure the effect of short-cutting scanning for blocks by starting at the startpc. + It measures how much time is used to scan for the pcs from the last block to the end of all methods containing blocks. Uncomment out the short-cut above to compare time with the optimization and time without. I see approximately 290ms for all such methods with the optimization and 292 ms without, so given that this slows down the substantial majority of methods without blocks, we KISS." + "| candidates | + candidates := Dictionary new. + self systemNavigation allSelect: + [:m| | ebc | + (m isQuick or: [(ebc := m embeddedBlockClosures) isEmpty]) ifFalse: + [candidates at: m put: { ebc last. + Array streamContents: + [:s| | is | + (is:= InstructionStream on: m) + pc: ebc last startpc; + scanFor: + [:b| + s nextPut: is pc. + false]] }]. + false]. + (1 to: 10) collect: + [:ign| + { [candidates keysAndValuesDo: + [:m :tuple| + [:ebc :pcs| | c | + c := ebc outerContext. + pcs do: + [:pc| m encoderClass pcPreviousTo: pc in: m for: c]] valueWithArguments: tuple]] timeToRun. + [candidates keysAndValuesDo: + [:m :tuple| + [:ebc :pcs| | c | + c := ebc outerContext. + pcs do: + [:pc| m encoderClass pcPreviousTo: pc in: m for: nil]] valueWithArguments: tuple]] timeToRun. }]"! Item was added: + ----- Method: BytecodeEncoder class>>pushClosureBytecodeSize (in category 'bytecode decoding') ----- + pushClosureBytecodeSize + "Answer the size of the push closure bytecode, if there is one." + ^self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>pushNewArrayCode (in category 'bytecode decoding') ----- + pushNewArrayCode + "Answer the pushNewArray bytecode, if it exists in the encoder's bytecode set, or nil if not." + ^nil! Item was added: + ----- Method: BytecodeEncoder class>>pushNilCode (in category 'bytecode decoding') ----- + pushNilCode + "Answer the pushNil bytecode." + ^self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>scanBlockOrNilForLiteral: (in category 'scanning') ----- + scanBlockOrNilForLiteral: aLiteral + "Answer a block argument for CompiledMethod>>#scanFor: that answers + if the method refers to the literal implicitly via a special bytecode. + If the literal is not accessible via a special bytecode, answer nil. + Subclasses override as appropriate" + ^nil! Item was added: + ----- Method: BytecodeEncoder class>>selectorToSendOrItselfFor:in:at: (in category 'instruction stream support') ----- + selectorToSendOrItselfFor: anInstructionStream in: method at: pc + "If anInstructionStream is at a send bytecode then answer the send's selector, + otherwise answer anInstructionStream itself. The rationale for answering + anInstructionStream instead of, say, nil, is that potentially any existing object + can be used as a selector, but since anInstructionStream postdates the method, + it can't be one of them." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>stackDeltaForPrimitive:in: (in category 'bytecode decoding') ----- + stackDeltaForPrimitive: primitiveIndex in: method + "This is the default implementation. Subclasses with inline primitives will need to override." + ^0! Item was added: + ----- Method: BytecodeEncoder class>>superSendScanBlockUsing: (in category 'compiled method support') ----- + superSendScanBlockUsing: scanner + "Answer a block argument for InstructionStream>>scanFor: + that answers true for super sends." + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>supportsClosures (in category 'compiled method support') ----- + supportsClosures + "Answer if the instruction set supports closures (contains + closure creation and indirect temp access bytecodes)." + + self subclassResponsibility! Item was added: + ----- Method: BytecodeEncoder class>>supportsFullBlocks (in category 'testing') ----- + supportsFullBlocks + "Answer if the instruction set supports full closures (closure creation from + specfic methods instead of bytecodes embedded in an outer home method)." + + ^self basicNew supportsFullBlocks! Item was added: + ----- Method: BytecodeEncoder class>>unusedBytecode (in category 'bytecode decoding') ----- + unusedBytecode + "Answer the opcode of a single-byte unused bytecode, if it exists in the encoder's bytecode set, or nil if not." + ^nil! Item was added: + ----- Method: BytecodeEncoder>>allLiteralsForBlockMethod (in category 'results') ----- + allLiteralsForBlockMethod + addedExtraLiterals ifFalse: + [addedExtraLiterals := true. + "Put the optimized selectors in literals so as to browse senders more easily" + optimizedSelectors := optimizedSelectors reject: [:e| literalStream originalContents hasLiteral: e]. + optimizedSelectors isEmpty ifFalse: [ + "Use one entry per literal if enough room, else make anArray" + literalStream position + optimizedSelectors size + 2 >= self maxNumLiterals + ifTrue: [self litIndex: optimizedSelectors asArray] + ifFalse: [optimizedSelectors do: [:e | self litIndex: e]]]. + "Add a slot for outerCode" + self litIndex: nil]. + ^literalStream contents! Item was added: + ----- Method: BytecodeEncoder>>bindAndJuggle: (in category 'temps') ----- + bindAndJuggle: name + "This is used to insert a new temp and reorcder temps on editing. + It doesn't really work for closure compilation since we have multiple + locations for temps. Simply signal a reparse is necessary." + + ReparseAfterSourceEditing signal! Item was added: + ----- Method: BytecodeEncoder>>bindBlockArg:within: (in category 'temps') ----- + bindBlockArg: name within: aBlockNode + | nArgs | + (nArgs := aBlockNode nArgsSlot) isNil ifTrue: + [aBlockNode nArgsSlot: (nArgs := 0)]. + nArgs >= 15 ifTrue: + [^self notify: 'Too many arguments']. + aBlockNode nArgsSlot: nArgs + 1. + ^(self bindTemp: name) + beBlockArg; + nowHasDef; + nowHasRef; + yourself! Item was added: + ----- Method: BytecodeEncoder>>bindBlockTemp: (in category 'temps') ----- + bindBlockTemp: name + "This shouldn't be used with BytecodeEncoder. Use bindBlockTemp:within: instead." + self shouldNotImplement! Item was added: + ----- Method: BytecodeEncoder>>bindBlockTemp:within: (in category 'temps') ----- + bindBlockTemp: name within: aBlockNode + | nArgs | + (nArgs := aBlockNode nArgsSlot) ifNil: + [aBlockNode nArgsSlot: (nArgs := 0)]. + nArgs >= (CompiledMethod fullFrameSize - 1) ifTrue: + [^self notify: 'Too many temporaries']. + aBlockNode nArgsSlot: nArgs + 1. + ^self bindTemp: name! Item was added: + ----- Method: BytecodeEncoder>>bindTemp: (in category 'temps') ----- + bindTemp: name + "Declare a temporary; error not if a field or class variable or out-of-scope temp." + scopeTable at: name ifPresent: + [:node| + "When non-interactive raise the error only if it is a duplicate" + node isTemp + ifTrue:[node scope >= 0 ifTrue: + [^self notify: 'Name already used in this method']] + ifFalse:[self warnAboutShadowed: name]]. + ^self reallyBind: name! Item was added: + ----- Method: BytecodeEncoder>>blockExtentsToTempsMap (in category 'temps') ----- + blockExtentsToTempsMap + "Answer a Dictionary of blockExtent to temp locations for the current method. + This is used by the debugger to locate temp vars in contexts. A temp map + entry is a pair of the temp's name and its index, where an index is either an + integer for a normal temp or a pair of the index of the indirect temp vector + containing the temp and the index of the temp in its indirect temp vector." + | blockExtentsToTempsMap | + blockExtentsToLocals ifNil: + [^nil]. + blockExtentsToTempsMap := Dictionary new. + blockExtentsToLocals keysAndValuesDo: + [:blockExtent :locals| + blockExtentsToTempsMap + at: blockExtent + put: (Array streamContents: + [:aStream| + locals withIndexDo: + [:local :index| + local isIndirectTempVector + ifTrue: [local remoteTemps withIndexDo: + [:remoteLocal :innerIndex| aStream nextPut: { remoteLocal key. { index. innerIndex } }]] + ifFalse: [aStream nextPut: { local key. index }]]])]. + ^blockExtentsToTempsMap! Item was added: + ----- Method: BytecodeEncoder>>blockLiteralFor: (in category 'full blocks') ----- + blockLiteralFor: aBlockNode + "Answer a new CompiledBlock for the code in aBlockNode" + ^self reindexingLiteralsDo: + [self shallowCopy resetForFullBlockGeneration + generateBlockMethodOfClass: CompiledBlock + trailer: CompiledMethodTrailer empty + from: aBlockNode]! Item was added: + ----- Method: BytecodeEncoder>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') ----- + computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex + numArgs > 15 ifTrue: + [^self error: 'Cannot compile -- too many arguments']. + numTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + numLits > self maxNumLiterals ifTrue: + [^self error: 'Cannot compile -- too many literals']. + ^(CompiledMethod headerFlagForEncoder: self) + + (numArgs bitShift: 24) + + (numTemps bitShift: 18) + "+ (largeBit bitShift: 17)" "largeBit gets filled in later" + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]) + "+ (optimizedBit bitShift: 15)" "Sista marker may get filled in later" + + numLits! Item was added: + ----- Method: BytecodeEncoder>>genPushNClosureTemps: (in category 'bytecode generation') ----- + genPushNClosureTemps: numTemps + "To reduce the number of bytecodes required, the embedded + block closure implementation uses explicit push nil instructions + to create block-local temps. In bytecode sets supporting + FullBlockClosure/CompiledBlock this isn't needed and the + number of temps is derived from the block method header." + numTemps timesRepeat: [self genPushSpecialLiteral: nil]! Item was added: + ----- Method: BytecodeEncoder>>generateBlockMethodOfClass:trailer:from: (in category 'method generation') ----- + generateBlockMethodOfClass: aCompiledBlockClass trailer: trailer from: blockNode + "Generate a CompiledBlock for the block whose parse tree is blockNode." + + "The closure analysis should already have been done." + | blkSize header literals locals method nLits stack | + self assert: blockNode blockExtent notNil. + self assert: rootNode notNil. + blkSize := blockNode sizeCodeForEvaluatedFullClosureValue: self. + locals := blockNode localsNodes. + self noteBlockExtent: blockNode blockExtent hasLocals: locals. + header := self computeMethodHeaderForNumArgs: blockNode arguments size + numTemps: locals size + numLits: (nLits := (literals := self allLiteralsForBlockMethod) size) + primitive: 0. + method := trailer + createMethod: blkSize + class: aCompiledBlockClass + header: header. + 1 to: nLits do: + [:lit | + (method literalAt: lit put: (literals at: lit)) isCompiledCode ifTrue: + [(literals at: lit) outerCode: method]]. + self streamToMethod: method. + stack := ParseStack new init. + stack position: method numTemps. + blockMethod := method. "For BytecodeEncoder>>pc & BytecodeEncoder>>nextPC" + [blockNode emitCodeForEvaluatedFullClosureValue: stack encoder: self] + on: Error "If an attempt is made to write too much code the method will be asked" + do: [:ex| "to grow, and the grow attempt will fail in CompiledCode class>>#newMethodViaNewError" + ex signalerContext sender method = (CompiledCode class>>#newMethodViaNewError) + ifTrue: [^self error: 'Compiler code size discrepancy'] + ifFalse: [ex pass]]. + stack position ~= (method numTemps + 1) ifTrue: + [^self error: 'Compiler stack discrepancy']. + stream position ~= (method size - trailer size) ifTrue: + [^self error: 'Compiler code size discrepancy']. + method needsFrameSize: stack size - method numTemps. + ^method! Item was added: + ----- Method: BytecodeEncoder>>generateMethodOfClass:trailer:from: (in category 'method generation') ----- + generateMethodOfClass: aCompiledMethodClass trailer: trailer from: methodNode + "The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass. + The argument, trailer, is arbitrary but is typically either the reference to the source code + that is stored with every CompiledMethod, or an encoding of the method's temporary names." + + | primErrNode blkSize nLits locals literals header method stack | + primErrNode := methodNode primitiveErrorVariableName ifNotNil: + [self fixTemp: methodNode primitiveErrorVariableName]. + methodNode ensureClosureAnalysisDone. + self rootNode: methodNode. "this is for BlockNode>>sizeCodeForClosureValue:" + blkSize := (methodNode block sizeCodeForEvaluatedValue: self) + + (methodNode primitive > 0 + ifTrue: [self sizeCallPrimitive: methodNode primitive] + ifFalse: [0]) + + (primErrNode + ifNil: [0] + ifNotNil: + [primErrNode + index: methodNode arguments size + methodNode temporaries size; + sizeCodeForStore: self "The VM relies on storeIntoTemp: (129)"]). + locals := methodNode arguments, methodNode temporaries, (primErrNode ifNil: [#()] ifNotNil: [{primErrNode}]). + self noteBlockExtent: methodNode block blockExtent hasLocals: locals. + header := self computeMethodHeaderForNumArgs: methodNode arguments size + numTemps: locals size + numLits: (nLits := (literals := self allLiterals) size) + primitive: methodNode primitive. + method := trailer + createMethod: blkSize + class: aCompiledMethodClass + header: header. + 1 to: nLits do: + [:lit | + (method literalAt: lit put: (literals at: lit)) isCompiledCode ifTrue: + [(literals at: lit) outerCode: method]]. + self streamToMethod: method. + stack := ParseStack new init. + methodNode primitive > 0 ifTrue: + [self genCallPrimitive: methodNode primitive]. + primErrNode ifNotNil: + [primErrNode emitCodeForStore: stack encoder: self]. + stack position: method numTemps. + [methodNode block emitCodeForEvaluatedValue: stack encoder: self] + on: Error "If an attempt is made to write too much code the method will be asked" + do: [:ex| "to grow, and the grow attempt will fail in CompiledCode class>>#newMethodViaNewError" + ex signalerContext sender method = (CompiledCode class>>#newMethodViaNewError) + ifTrue: [^self error: 'Compiler code size discrepancy'] + ifFalse: [ex pass]]. + stack position ~= (method numTemps + 1) ifTrue: + [^self error: 'Compiler stack discrepancy']. + stream position ~= (method size - trailer size) ifTrue: + [^self error: 'Compiler code size discrepancy']. + method needsFrameSize: stack size - method numTemps. + ^method! Item was added: + ----- Method: BytecodeEncoder>>generatingFullBlock (in category 'testing') ----- + generatingFullBlock + "Answer if the encoder is currently generating a FullBlock, embedded in some method." + + "When generating a FullBlock a copy of the encoder for the home emthod (rootNode) + is used, and hence the following is true." + ^rootNode encoder ~~ self! Item was added: + ----- Method: BytecodeEncoder>>hasGeneratedMethod (in category 'testing') ----- + hasGeneratedMethod + ^blockExtentsToLocals notNil! Item was added: + ----- Method: BytecodeEncoder>>if:isSpecialLiteralForPush: (in category 'special literal encodings') ----- + if: code isSpecialLiteralForPush: aBlock + "If code is that of a special literal for push then evaluate aBlock with the special literal + The special literals for push are at least nil true false which have special encodings + in the blue book bytecode set. Answer whether it was a special literal." + ^(code between: LdTrue and: LdNil) + and: [aBlock value: (#(true false nil) at: code - LdSelf). + true]! Item was added: + ----- Method: BytecodeEncoder>>if:isSpecialLiteralForReturn: (in category 'special literal encodings') ----- + if: code isSpecialLiteralForReturn: aBlock + "If code is that of a special literal for return then evaluate aBlock with the special literal. + The special literals for return are nil true false which have special encodings + in the blue book bytecode set. Answer whether it was a special literal." + ^(code between: LdTrue and: LdNil) + and: [aBlock value: (#(true false nil) at: code - LdSelf). + true]! Item was added: + ----- Method: BytecodeEncoder>>methodStreamPosition (in category 'accessing') ----- + methodStreamPosition + ^stream position! Item was added: + ----- Method: BytecodeEncoder>>nextPC (in category 'accessing') ----- + nextPC + "Answer the pc to store in a node for source range identification when the node is associated with its following pc." + ^blockMethod + ifNil: [stream position + 1] + ifNotNil: [:proxy| proxy -> (stream position + 1)]! Item was added: + ----- Method: BytecodeEncoder>>nextPut: (in category 'opcode sizing') ----- + nextPut: aByte + "For sizing make the encoder its own stream and + keep track of position with this version of nextPut:" + position := position + 1! Item was added: + ----- Method: BytecodeEncoder>>noteBlockExtent:hasLocals: (in category 'temps') ----- + noteBlockExtent: blockExtent hasLocals: tempNodes + blockExtentsToLocals ifNil: + [blockExtentsToLocals := Dictionary new]. + blockExtentsToLocals at: blockExtent put: tempNodes asArray! Item was added: + ----- Method: BytecodeEncoder>>outOfRangeError:index:range:to: (in category 'bytecode generation') ----- + outOfRangeError: string index: index range: rangeStart to: rangeEnd + "For now..." + ^self error: thisContext sender method selector, ' ', string + , ' index ', index printString + , ' is out of range ', rangeStart printString, ' to ', rangeEnd printString! Item was added: + ----- Method: BytecodeEncoder>>pc (in category 'accessing') ----- + pc + "Answer the pc to store in a node for source range identification." + ^blockMethod + ifNil: [stream position] + ifNotNil: [:aCompiledBlock| aCompiledBlock -> stream position]! Item was added: + ----- Method: BytecodeEncoder>>printSchematicTempNamesOn:blockExtents:fromIndex: (in category 'results') ----- + printSchematicTempNamesOn: aStream blockExtents: blockExtents fromIndex: startIndex + "Print the locals in the blockExtent startIndex, recursing to print any locals in nested blockExtents. + Answer the index of the last blockExtent printed." + | blockExtent subsequentIndex | + blockExtent := blockExtents at: startIndex. + blockExtent first > 0 ifTrue: + [aStream nextPut: $[ ]. + ((blockExtentsToLocals at: blockExtent) reject: [:local| local isRemote]) + do: [:local| + local isIndirectTempVector + ifTrue: + [aStream nextPut: $(. + local remoteTemps + do: [:remoteLocal| aStream nextPutAll: remoteLocal key] + separatedBy: [aStream space]. + aStream nextPut: $)] + ifFalse: [aStream nextPutAll: local key]] + separatedBy: [aStream space]. + subsequentIndex := startIndex + 1. + [subsequentIndex <= blockExtents size + and: [(blockExtents at: subsequentIndex) last < blockExtent last]] whileTrue: + [subsequentIndex := self printSchematicTempNamesOn: aStream + blockExtents: blockExtents + fromIndex: subsequentIndex]. + blockExtent first > 0 ifTrue: + [aStream nextPut: $] ]. + ^subsequentIndex! Item was added: + ----- Method: BytecodeEncoder>>reindexingLiteralsDo: (in category 'code generation') ----- + reindexingLiteralsDo: aBlock + "Reset any and all literals so that they will be given new indices in + the literalStream during aBlock (which will be used to generate a + nested block method). Afterwards restore those same literals to + their original state, and reset any and all new literals added during + aBlock so that they will be given new indices if used subsequently." + | savedNodes saveBlock | + savedNodes := IdentityDictionary new. + saveBlock := [:node| + savedNodes at: node put: node shallowCopy. + node resetForBlockGeneration]. + litSet do: saveBlock. + litIndSet do: saveBlock. + selectorSet do: saveBlock. + ^aBlock ensure: + [| restoreBlock | + restoreBlock := [:node| + savedNodes + at: node + ifPresent: [:copy| node resetFromCopy: copy] + ifAbsent: [node resetForBlockGeneration]]. + litSet do: restoreBlock. + litIndSet do: restoreBlock. + selectorSet do: restoreBlock]! Item was added: + ----- Method: BytecodeEncoder>>resetForFullBlockGeneration (in category 'code generation') ----- + resetForFullBlockGeneration + literalStream := WriteStream on: (Array new: 8). + addedExtraLiterals := false. + optimizedSelectors := Set new! Item was added: + ----- Method: BytecodeEncoder>>resetLiteralStreamForFullBlock (in category 'code generation') ----- + resetLiteralStreamForFullBlock + literalStream := WriteStream on: (Array new: 32). + addedExtraLiterals := false. + optimizedSelectors := Set new! Item was added: + ----- Method: BytecodeEncoder>>rootNode (in category 'accessing') ----- + rootNode "^<BlockNode>" + ^rootNode! Item was added: + ----- Method: BytecodeEncoder>>rootNode: (in category 'accessing') ----- + rootNode: node "<BlockNode>" + rootNode := node! Item was added: + ----- Method: BytecodeEncoder>>schematicTempNamesString (in category 'results') ----- + schematicTempNamesString + "Answer the temp names for the current method node in a form that captures + temp structure. The temps at each method and block scope level occurr + space-separated, with any indirect temps enclosed in parentheses. Each block + level is enclosed in square brackets. e.g. + 'method level temps (indirect temp)[block args and temps (indirect)]' + This representation can be reconstituted into a blockExtentsToTempsMap + by a CompiledMethod that has been copied with teh schematicTempNamesString." + blockExtentsToLocals ifNil: + [self error: 'blockExtentsToLocals uninitialized. method not yet generated?']. + ^String streamContents: + [:aStream| + self printSchematicTempNamesOn: aStream + blockExtents: (blockExtentsToLocals keys asArray sort: + [:range1 :range2| + range1 first <= range2 first]) + fromIndex: 1]! Item was added: + ----- Method: BytecodeEncoder>>sizeBranchPopFalse: (in category 'opcode sizing') ----- + sizeBranchPopFalse: distance + ^self sizeOpcodeSelector: #genBranchPopFalse: withArguments: {distance}! Item was added: + ----- Method: BytecodeEncoder>>sizeBranchPopTrue: (in category 'opcode sizing') ----- + sizeBranchPopTrue: distance + ^self sizeOpcodeSelector: #genBranchPopTrue: withArguments: {distance}! Item was added: + ----- Method: BytecodeEncoder>>sizeCallPrimitive: (in category 'opcode sizing') ----- + sizeCallPrimitive: primitiveIndex + ^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeDup (in category 'opcode sizing') ----- + sizeDup + ^self sizeOpcodeSelector: #genDup withArguments: #()! Item was added: + ----- Method: BytecodeEncoder>>sizeJump: (in category 'opcode sizing') ----- + sizeJump: distance + ^self sizeOpcodeSelector: #genJump: withArguments: {distance}! Item was added: + ----- Method: BytecodeEncoder>>sizeJumpLong: (in category 'opcode sizing') ----- + sizeJumpLong: distance + ^self sizeOpcodeSelector: #genJumpLong: withArguments: {distance}! Item was added: + ----- Method: BytecodeEncoder>>sizeOpcodeSelector:withArguments: (in category 'opcode sizing') ----- + sizeOpcodeSelector: genSelector withArguments: args + stream := self. + position := 0. + self perform: genSelector withArguments: args. + ^position! Item was added: + ----- Method: BytecodeEncoder>>sizePop (in category 'opcode sizing') ----- + sizePop + ^self sizeOpcodeSelector: #genPop withArguments: #()! Item was added: + ----- Method: BytecodeEncoder>>sizePushClosureCopyNumCopiedValues:numArgs:jumpSize: (in category 'opcode sizing') ----- + sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: jumpSize + ^self + sizeOpcodeSelector: #genPushClosureCopyNumCopiedValues:numArgs:jumpSize: + withArguments: {numCopied. numArgs. jumpSize}! Item was added: + ----- Method: BytecodeEncoder>>sizePushConsArray: (in category 'opcode sizing') ----- + sizePushConsArray: numElements + ^self sizeOpcodeSelector: #genPushConsArray: withArguments: {numElements}! Item was added: + ----- Method: BytecodeEncoder>>sizePushFullClosure:numCopied: (in category 'opcode sizing') ----- + sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied + ^self sizeOpcodeSelector: #genPushFullClosure:numCopied: + withArguments: {compiledBlockLiteralIndex. numCopied}! Item was added: + ----- Method: BytecodeEncoder>>sizePushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'opcode sizing') ----- + sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: receiverOnStack ignoreOuterContext: ignoreOuterContext + ^self sizeOpcodeSelector: #genPushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: + withArguments: {compiledBlockLiteralIndex. numCopied. receiverOnStack. ignoreOuterContext}! Item was added: + ----- Method: BytecodeEncoder>>sizePushInstVar: (in category 'opcode sizing') ----- + sizePushInstVar: instVarIndex + ^self sizeOpcodeSelector: #genPushInstVar: withArguments: {instVarIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizePushInstVarLong: (in category 'opcode sizing') ----- + sizePushInstVarLong: instVarIndex + ^self sizeOpcodeSelector: #genPushInstVarLong: withArguments: {instVarIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizePushLiteral: (in category 'opcode sizing') ----- + sizePushLiteral: literalIndex + ^self sizeOpcodeSelector: #genPushLiteral: withArguments: {literalIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizePushLiteralVar: (in category 'opcode sizing') ----- + sizePushLiteralVar: literalIndex + ^self sizeOpcodeSelector: #genPushLiteralVar: withArguments: {literalIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizePushNClosureTemps: (in category 'opcode sizing') ----- + sizePushNClosureTemps: numTemps + ^self sizeOpcodeSelector: #genPushNClosureTemps: withArguments: {numTemps}! Item was added: + ----- Method: BytecodeEncoder>>sizePushNewArray: (in category 'opcode sizing') ----- + sizePushNewArray: size + ^self sizeOpcodeSelector: #genPushNewArray: withArguments: {size}! Item was added: + ----- Method: BytecodeEncoder>>sizePushReceiver (in category 'opcode sizing') ----- + sizePushReceiver + ^self sizeOpcodeSelector: #genPushReceiver withArguments: #()! Item was added: + ----- Method: BytecodeEncoder>>sizePushRemoteTemp:inVectorAt: (in category 'opcode sizing') ----- + sizePushRemoteTemp: tempIndex inVectorAt: tempVectorIndex + ^self sizeOpcodeSelector: #genPushRemoteTemp:inVectorAt: withArguments: {tempIndex. tempVectorIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizePushSpecialLiteral: (in category 'opcode sizing') ----- + sizePushSpecialLiteral: specialLiteral + ^self sizeOpcodeSelector: #genPushSpecialLiteral: withArguments: {specialLiteral}! Item was added: + ----- Method: BytecodeEncoder>>sizePushTemp: (in category 'opcode sizing') ----- + sizePushTemp: tempIndex + ^self sizeOpcodeSelector: #genPushTemp: withArguments: {tempIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizePushTempLong: (in category 'opcode sizing') ----- + sizePushTempLong: tempIndex + ^self sizeOpcodeSelector: #genPushTempLong: withArguments: {tempIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizePushThisContext (in category 'opcode sizing') ----- + sizePushThisContext + ^self sizeOpcodeSelector: #genPushThisContext withArguments: #()! Item was added: + ----- Method: BytecodeEncoder>>sizeReturnNilToCaller (in category 'opcode sizing') ----- + sizeReturnNilToCaller + ^self sizeOpcodeSelector: #genReturnNilToCaller withArguments: #()! Item was added: + ----- Method: BytecodeEncoder>>sizeReturnReceiver (in category 'opcode sizing') ----- + sizeReturnReceiver + ^self sizeOpcodeSelector: #genReturnReceiver withArguments: #()! Item was added: + ----- Method: BytecodeEncoder>>sizeReturnSpecialLiteral: (in category 'opcode sizing') ----- + sizeReturnSpecialLiteral: specialLiteral + ^self sizeOpcodeSelector: #genReturnSpecialLiteral: withArguments: {specialLiteral}! Item was added: + ----- Method: BytecodeEncoder>>sizeReturnTop (in category 'opcode sizing') ----- + sizeReturnTop + ^self sizeOpcodeSelector: #genReturnTop withArguments: #()! Item was added: + ----- Method: BytecodeEncoder>>sizeReturnTopToCaller (in category 'opcode sizing') ----- + sizeReturnTopToCaller + ^self sizeOpcodeSelector: #genReturnTopToCaller withArguments: #()! Item was added: + ----- Method: BytecodeEncoder>>sizeSend:numArgs: (in category 'opcode sizing') ----- + sizeSend: selectorLiteralIndex numArgs: nArgs + ^self sizeOpcodeSelector: #genSend:numArgs: withArguments: {selectorLiteralIndex. nArgs}! Item was added: + ----- Method: BytecodeEncoder>>sizeSendDirectedSuper:numArgs: (in category 'opcode sizing') ----- + sizeSendDirectedSuper: selectorLiteralIndex numArgs: numArgs + ^self sizeOpcodeSelector: #genSendDirectedSuper:numArgs: withArguments: {selectorLiteralIndex. numArgs}! Item was added: + ----- Method: BytecodeEncoder>>sizeSendSpecial:numArgs: (in category 'opcode sizing') ----- + sizeSendSpecial: specialSelectorIndex numArgs: nArgs + ^self sizeOpcodeSelector: #genSendSpecial:numArgs: withArguments: {specialSelectorIndex. nArgs}! Item was added: + ----- Method: BytecodeEncoder>>sizeSendSuper:numArgs: (in category 'opcode sizing') ----- + sizeSendSuper: selectorLiteralIndex numArgs: nArgs + ^self sizeOpcodeSelector: #genSendSuper:numArgs: withArguments: {selectorLiteralIndex. nArgs}! Item was added: + ----- Method: BytecodeEncoder>>sizeStoreInstVar: (in category 'opcode sizing') ----- + sizeStoreInstVar: instVarIndex + ^self sizeOpcodeSelector: #genStoreInstVar: withArguments: {instVarIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStoreInstVarLong: (in category 'opcode sizing') ----- + sizeStoreInstVarLong: instVarIndex + ^self sizeOpcodeSelector: #genStoreInstVarLong: withArguments: {instVarIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStoreLiteralVar: (in category 'opcode sizing') ----- + sizeStoreLiteralVar: literalIndex + ^self sizeOpcodeSelector: #genStoreLiteralVar: withArguments: {literalIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStorePopInstVar: (in category 'opcode sizing') ----- + sizeStorePopInstVar: instVarIndex + ^self sizeOpcodeSelector: #genStorePopInstVar: withArguments: {instVarIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStorePopInstVarLong: (in category 'opcode sizing') ----- + sizeStorePopInstVarLong: instVarIndex + ^self sizeOpcodeSelector: #genStorePopInstVarLong: withArguments: {instVarIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStorePopLiteralVar: (in category 'opcode sizing') ----- + sizeStorePopLiteralVar: literalIndex + ^self sizeOpcodeSelector: #genStorePopLiteralVar: withArguments: {literalIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStorePopRemoteTemp:inVectorAt: (in category 'opcode sizing') ----- + sizeStorePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex + ^self sizeOpcodeSelector: #genStorePopRemoteTemp:inVectorAt: withArguments: {tempIndex. tempVectorIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStorePopTemp: (in category 'opcode sizing') ----- + sizeStorePopTemp: tempIndex + ^self sizeOpcodeSelector: #genStorePopTemp: withArguments: {tempIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStoreRemoteTemp:inVectorAt: (in category 'opcode sizing') ----- + sizeStoreRemoteTemp: tempIndex inVectorAt: tempVectorIndex + ^self sizeOpcodeSelector: #genStoreRemoteTemp:inVectorAt: withArguments: {tempIndex. tempVectorIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeStoreTemp: (in category 'opcode sizing') ----- + sizeStoreTemp: tempIndex + ^self sizeOpcodeSelector: #genStoreTemp: withArguments: {tempIndex}! Item was added: + ----- Method: BytecodeEncoder>>sizeTrapIfNotInstanceOf: (in category 'opcode sizing') ----- + sizeTrapIfNotInstanceOf: litIndex + ^self sizeOpcodeSelector: #genTrapIfNotInstanceOf: withArguments: {litIndex}! Item was added: + ----- Method: BytecodeEncoder>>streamToMethod: (in category 'initialize-release') ----- + streamToMethod: aCompiledMethod + stream := WriteStream with: aCompiledMethod. + stream position: aCompiledMethod initialPC - 1! Item was added: + ----- Method: BytecodeEncoder>>supportsFullBlocks (in category 'testing') ----- + supportsFullBlocks + "Answer if the instruction set supports full closures (closure creation from + specfic methods instead of bytecodes embedded in an outer home method)." + + ^self subclassResponsibility! Item was added: + ParseNode subclass: #CascadeNode + instanceVariableNames: 'receiver messages' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !CascadeNode commentStamp: '<historical>' prior: 0! + The first message has the common receiver, the rest have receiver == nil, which signifies cascading.! Item was added: + ----- Method: CascadeNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitCascadeNode: self! Item was added: + ----- Method: CascadeNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + { receiver }, messages do: + [:node| node analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools]! Item was added: + ----- Method: CascadeNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + receiver emitCodeForValue: stack encoder: encoder. + 1 to: messages size - 1 do: + [:i | + encoder genDup. + stack push: 1. + (messages at: i) emitCodeForValue: stack encoder: encoder. + encoder genPop. + stack pop: 1]. + messages last emitCodeForValue: stack encoder: encoder! Item was added: + ----- Method: CascadeNode>>messages (in category 'accessing') ----- + messages + ^messages! Item was added: + ----- Method: CascadeNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + self printOn: aStream indent: level precedence: 0! Item was added: + ----- Method: CascadeNode>>printOn:indent:precedence: (in category 'printing') ----- + printOn: aStream indent: level precedence: p + + p > 0 ifTrue: [aStream nextPut: $(]. + messages first printReceiver: receiver on: aStream indent: level. + 1 to: messages size do: + [:i | (messages at: i) printOn: aStream indent: level. + i < messages size ifTrue: + [aStream nextPut: $;. + messages first precedence >= 2 ifTrue: [aStream crtab: level + 1]]]. + p > 0 ifTrue: [aStream nextPut: $)]! Item was added: + ----- Method: CascadeNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + self printWithClosureAnalysisOn: aStream indent: level precedence: 0! Item was added: + ----- Method: CascadeNode>>printWithClosureAnalysisOn:indent:precedence: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level precedence: p + + p > 0 ifTrue: [aStream nextPut: $(]. + messages first printWithClosureAnalysisReceiver: receiver on: aStream indent: level. + 1 to: messages size do: + [:i | (messages at: i) printWithClosureAnalysisOn: aStream indent: level. + i < messages size ifTrue: + [aStream nextPut: $;. + messages first precedence >= 2 ifTrue: [aStream crtab: level + 1]]]. + p > 0 ifTrue: [aStream nextPut: $)]! Item was added: + ----- Method: CascadeNode>>receiver (in category 'accessing') ----- + receiver + ^receiver! Item was added: + ----- Method: CascadeNode>>receiver:messages: (in category 'initialize-release') ----- + receiver: receivingObject messages: msgs + " Transcript show: 'abc'; cr; show: 'def' " + + receiver := receivingObject. + messages := msgs! Item was added: + ----- Method: CascadeNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + | size | + size := (receiver sizeCodeForValue: encoder) + + (messages size - 1 * (encoder sizeDup + encoder sizePop)). + messages do: [:aMessage | size := size + (aMessage sizeCodeForValue: encoder)]. + ^size! Item was added: + TextStream subclass: #ColoredCodeStream + instanceVariableNames: 'dialect colorTable' + classVariableNames: 'ST80ColorTable' + poolDictionaries: '' + category: 'Compiler-Kernel'! Item was added: + ----- Method: ColoredCodeStream class>>contents: (in category 'instance creation') ----- + contents: blockWithArg + "Evaluate blockWithArg on a DialectStream of the given description" + + | stream | + stream := self on: (Text new: 400). + blockWithArg value: stream. + ^ stream contents! Item was added: + ----- Method: ColoredCodeStream class>>initialize (in category 'class initialization') ----- + initialize + "Initialize the colors that characterize the ST80 dialect" + + ST80ColorTable := IdentityDictionary new. + #( (temporaryVariable blue italic) + (methodArgument blue normal) + (methodSelector black bold) + (blockArgument red normal) + (comment brown normal) + (variable magenta normal) + (literal orange normal) + (keyword darkGray bold) + (prefixKeyword veryDarkGray bold) + (setOrReturn black bold)) do: + [:aTriplet | + ST80ColorTable at: aTriplet first put: aTriplet allButFirst] + + "ColoredCodeStream initialize"! Item was added: + ----- Method: ColoredCodeStream>>colorTable (in category 'color/style') ----- + colorTable + "Answer the table to use to determine colors" + + ^ colorTable ifNil: [colorTable := ST80ColorTable]! Item was added: + ----- Method: ColoredCodeStream>>withColor:emphasis:do: (in category 'color/style') ----- + withColor: colorSymbol emphasis: emphasisSymbol do: aBlock + "Evaluate the given block with the given color and style text attribute" + + ^ self withAttributes: {TextColor color: (Color perform: colorSymbol). + TextEmphasis perform: emphasisSymbol} + do: aBlock! Item was added: + ----- Method: ColoredCodeStream>>withStyleFor:do: (in category 'color/style') ----- + withStyleFor: elementType do: aBlock + "Evaluate aBlock with appropriate emphasis and color for the given elementType" + + | colorAndStyle | + colorAndStyle := self colorTable at: elementType. + ^ self withColor: colorAndStyle first emphasis: colorAndStyle second do: aBlock! Item was added: + ParseNode subclass: #CommentNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! Item was added: + ----- Method: CommentNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitCommentNode: self! Item was added: + Object subclass: #CompilationCue + instanceVariableNames: 'source sourceStream context receiver class environment requestor encoderClass methodTrailer' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !CompilationCue commentStamp: 'eem 3/30/2017 17:32' prior: 0! + A CompilationCue is a helper class holding enough context for evaluating/compiling Smalltalk code. + + That is mainly the source code, and the source code editor to interact with if the Compiler is used interactively. + But that is also any additional information necessary to resolve variable names. + + When compiling a method, the Compiler typically need to know the target class in which to install the method. + + When evaluating an expression, the Compiler also needs a receiver (for accessing the value of its instance variables), its class (for resolving instance/class variable names), and optionnally a context of execution when debugging a method (for accessing values of temporaries and parameters). + + Instance Variables + class: <Behavior> + context: <Context | nil> + environment: <Environment | nil> + receiver: <Object> + requestor: <TextEditor | nil> + source: <Stream> + + class + - the target class in which to install the compiled method; + this enables to resolve the instance variable names, class variable names and shared pool variable names. + When evaluating, this should be the receiver class + + context + - the context introspected when evaluating the code: this is typically for accessing parameters and temporary variables when debugging + + environment + - the environment in which to resolve global variable names + + receiver + - the receiver into which to evaluate the code: this is typically for accessing instance variables in an inspector + + requestor + - typically the text editor containing the source code being compiled/evaluated. This enables the Compiler to interact in case of syntax error. + + source + - a ReadStream on the source code to be compiled + ! Item was added: + ----- Method: CompilationCue class>>class: (in category 'instance creation') ----- + class: aClass + ^ self + source: nil + context: nil + receiver: nil + class: aClass + environment: (aClass ifNotNil: [aClass environment]) + requestor: nil! Item was added: + ----- Method: CompilationCue class>>source: (in category 'instance creation') ----- + source: aTextOrStream + ^ self + source: aTextOrStream + class: nil + requestor: nil! Item was added: + ----- Method: CompilationCue class>>source:class:environment:requestor: (in category 'instance creation') ----- + source: aTextOrStream class: aClass environment: anEnvironment requestor: anObject + ^ self + source: aTextOrStream + context: nil + receiver: nil + class: aClass + environment: anEnvironment + requestor: anObject! Item was added: + ----- Method: CompilationCue class>>source:class:requestor: (in category 'instance creation') ----- + source: aTextOrStream class: aClass requestor: anObject + ^ self + source: aTextOrStream + context: nil + receiver: nil + class: aClass + environment: (aClass ifNotNil: [aClass environment]) + requestor: anObject! Item was added: + ----- Method: CompilationCue class>>source:context:class:environment:requestor: (in category 'instance creation') ----- + source: aTextOrStream context: aContext class: aClass environment: anEnvironment requestor: reqObject + ^ self basicNew + initializeWithSource: aTextOrStream + context: aContext + receiver: (aContext ifNotNil: [aContext receiver]) + class: aClass + environment: anEnvironment + requestor: reqObject! Item was added: + ----- Method: CompilationCue class>>source:context:class:requestor: (in category 'instance creation') ----- + source: aTextOrStream context: aContext class: aClass requestor: anObject + ^ self + source: aTextOrStream + context: aContext + receiver: (aContext ifNotNil: [aContext receiver]) + class: aClass + environment: (aClass ifNotNil: [aClass environment]) + requestor: anObject! Item was added: + ----- Method: CompilationCue class>>source:context:receiver:class:environment:requestor: (in category 'instance creation') ----- + source: aTextOrStream context: aContext receiver: recObject class: aClass environment: anEnvironment requestor: reqObject + ^ self basicNew + initializeWithSource: aTextOrStream + context: aContext + receiver: recObject + class: aClass + environment: anEnvironment + requestor: reqObject! Item was added: + ----- Method: CompilationCue class>>source:environment: (in category 'instance creation') ----- + source: aString environment: anEnvironment + ^ self + source: aString + context: nil + receiver: nil + class: UndefinedObject + environment: anEnvironment + requestor: nil! Item was added: + ----- Method: CompilationCue class>>source:environment:requestor: (in category 'instance creation') ----- + source: aString environment: anEnvironment requestor: aRequestor + ^ self + source: aString + context: nil + receiver: nil + class: UndefinedObject + environment: anEnvironment + requestor: aRequestor! Item was added: + ----- Method: CompilationCue>>bindingOf: (in category 'binding') ----- + bindingOf: aSymbol + ^ class bindingOf: aSymbol environment: environment! Item was added: + ----- Method: CompilationCue>>context (in category 'accessing') ----- + context + ^ context! Item was added: + ----- Method: CompilationCue>>encoderClass (in category 'accessing') ----- + encoderClass + ^encoderClass! Item was added: + ----- Method: CompilationCue>>encoderClass: (in category 'accessing') ----- + encoderClass: aBytecodeEncoderClass + encoderClass := aBytecodeEncoderClass! Item was added: + ----- Method: CompilationCue>>environment (in category 'accessing') ----- + environment + ^ environment! Item was added: + ----- Method: CompilationCue>>getClass (in category 'accessing') ----- + getClass + ^ class! Item was added: + ----- Method: CompilationCue>>initializeWithSource:context:receiver:class:environment:requestor: (in category 'initialization') ----- + initializeWithSource: aTextOrStringOrStream context: aContext receiver: recObject class: aClass environment: anEnvironment requestor: reqObject + self initialize. + aTextOrStringOrStream isStream + ifTrue: [sourceStream := aTextOrStringOrStream] + ifFalse: + [source := aTextOrStringOrStream. + sourceStream := ReadStream on: aTextOrStringOrStream asString]. + context := aContext. + receiver := recObject. + class := aClass. + environment := anEnvironment. + requestor := reqObject! Item was added: + ----- Method: CompilationCue>>methodTrailer (in category 'accessing') ----- + methodTrailer + ^methodTrailer! Item was added: + ----- Method: CompilationCue>>methodTrailer: (in category 'accessing') ----- + methodTrailer: aCompiledMethodTrailer + methodTrailer := aCompiledMethodTrailer! Item was added: + ----- Method: CompilationCue>>receiver (in category 'accessing') ----- + receiver + ^ receiver! Item was added: + ----- Method: CompilationCue>>requestor (in category 'accessing') ----- + requestor + ^ requestor! Item was added: + ----- Method: CompilationCue>>source (in category 'accessing') ----- + source + ^source! Item was added: + ----- Method: CompilationCue>>source: (in category 'accessing') ----- + source: aString + + source := aString. + sourceStream := source readStream.! Item was added: + ----- Method: CompilationCue>>sourceStream (in category 'accessing') ----- + sourceStream + ^sourceStream! Item was added: + ----- Method: CompilationCue>>stringToLog (in category 'accessing') ----- + stringToLog + "Answer a string to be logged in a change log. + Implementation note: + If the requestor is a TextEditor, preferably take its selection. + This convoluted code is presumably crafted to avoid broken contents + (ReadStream on: '123456' from: 3 to: 4) contents -> '1234' + As long as selectionAsStream is using such construct this might be required." + | itsSelection itsSelectionString | + source ifNotNil: + [^source]. + ((requestor respondsTo: #selection) + and:[(itsSelection := requestor selection) notNil + and:[(itsSelectionString := itsSelection asString) isEmptyOrNil not]]) ifTrue: + [^itsSelectionString]. + ^sourceStream contents! Item was added: + ----- Method: CompiledMethod>>mapFromBlockKeys:toSchematicTemps: (in category '*Compiler-support') ----- + mapFromBlockKeys: keys toSchematicTemps: schematicTempNamesString + "Decode a schematicTempNamesString that encodes the layout of temp names + in a method and any closures/blocks within it, matching keys in keys to + vectors of temp names." + | map tempNames | + map := self newBlockStartMap. + tempNames := schematicTempNamesString readStream. + keys do: + [:key| | tempSequence tempIndex | + tempSequence := OrderedCollection new. + tempIndex := 0. + [(tempNames skipSeparators; peek) ifNil: [true] ifNotNil: [:ch| '[]' includes: ch]] whileFalse: + [tempNames peek = $( + ifTrue: [tempSequence addAllLast: ((self tempsSubSequenceFrom: (tempNames next; yourself)) withIndexCollect: + [:temp :index| + { temp. { tempIndex + 1. index } }]). + tempNames peek ~= $) ifTrue: [self error: 'parse error']. + tempIndex := tempIndex + 1. + tempNames next] + ifFalse: [tempSequence addAllLast: ((self tempsSubSequenceFrom: tempNames) withIndexCollect: + [:temp :index| + { temp. tempIndex := tempIndex + 1 }])]]. + map at: key put: tempSequence asArray. + [tempNames peek = $]] whileTrue: [tempNames next]. + tempNames peek = $[ ifTrue: + [tempNames next]]. + ^map! Item was added: + ----- Method: CompiledMethod>>newBlockStartMap (in category '*Compiler-private') ----- + newBlockStartMap + "If blocks are embedded then keys in the map are simple integer pcs and a Dictionary can be used. + If blocks are full (separate method objects) then keys in the map are CompiledBlocks and + IdentityDictionary must be used to avoid confusing blocks with identical code." + ^(self encoderClass supportsFullBlocks + ifTrue: [IdentityDictionary] + ifFalse: [Dictionary]) new! Item was added: + Object subclass: #CompiledMethodWithNode + instanceVariableNames: 'node method' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! Item was added: + ----- Method: CompiledMethodWithNode class>>generateMethodFromNode:trailer: (in category 'instance creation') ----- + generateMethodFromNode: aMethodNode trailer: bytes + ^ self method: (aMethodNode generate: bytes) node: aMethodNode.! Item was added: + ----- Method: CompiledMethodWithNode class>>method:node: (in category 'instance creation') ----- + method: aCompiledMethod node: aMethodNode + ^ self new method: aCompiledMethod; node: aMethodNode.! Item was added: + ----- Method: CompiledMethodWithNode>>method (in category 'accessing') ----- + method + ^ method! Item was added: + ----- Method: CompiledMethodWithNode>>method: (in category 'private') ----- + method: aCompiledMethod + method := aCompiledMethod! Item was added: + ----- Method: CompiledMethodWithNode>>node (in category 'accessing') ----- + node + ^ node! Item was added: + ----- Method: CompiledMethodWithNode>>node: (in category 'private') ----- + node: aMethodNode + node := aMethodNode! Item was added: + ----- Method: CompiledMethodWithNode>>selector (in category 'accessing') ----- + selector + ^ self node selector! Item was added: + Object subclass: #Compiler + instanceVariableNames: 'parser cue' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !Compiler commentStamp: 'cwp 12/26/2012 23:17' prior: 0! + The compiler accepts Smalltalk source code and compiles it with respect to a given class. The user of the compiler supplies a context so that temporary variables are accessible during compilation. If there is an error, a requestor (usually a kind of StringHolderController) is sent the message notify:at:in: so that the error message can be displayed. If there is no error, then the result of compilation is a MethodNode, which is the root of a parse tree whose nodes are kinds of ParseNodes. The parse tree can be sent messages to (1) generate code for a CompiledMethod (this is done for compiling methods or evaluating expressions); (2) pretty-print the code (for formatting); or (3) produce a map from object code back to source code (used by debugger program-counter selection). See also Parser, Encoder, ParseNode.! Item was added: + ----- Method: Compiler class>>couldEvaluate: (in category 'accessing') ----- + couldEvaluate: anObject + "Answer true if anObject can be passed to my various #evaluate: methods." + ^anObject isString or: [ anObject isText or: [ anObject isStream ]]! Item was added: + ----- Method: Compiler class>>decompilerClass (in category 'accessing') ----- + decompilerClass + ^Decompiler! Item was added: + ----- Method: Compiler class>>evaluate: (in category 'evaluating') ----- + evaluate: textOrString + "See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, + a Syntax Error view is created rather than notifying any requestor. + Compilation is carried out with respect to nil, i.e., no object, and the + invocation is not logged." + + ^self evaluate: textOrString for: nil! Item was added: + ----- Method: Compiler class>>evaluate:environment: (in category 'evaluating') ----- + evaluate: aString environment: anEnvironment + ^ self new + evaluateCue: (CompilationCue + source: aString + environment: anEnvironment) + ifFail: [^ nil]! Item was added: + ----- Method: Compiler class>>evaluate:environment:logged: (in category 'evaluating logged') ----- + evaluate: aString environment: anEnvironment logged: aBoolean + ^ self new + evaluateCue: (CompilationCue + source: aString + environment: anEnvironment) + ifFail: [^ nil] + logged: aBoolean! Item was added: + ----- Method: Compiler class>>evaluate:for: (in category 'evaluating') ----- + evaluate: textOrString for: anObject + "See Compiler|evaluate:for:notifying:. If a compilation error occurs, + a Syntax Error view is created rather than notifying any requestor." + + ^self evaluate: textOrString for: anObject notifying: nil! Item was added: + ----- Method: Compiler class>>evaluate:for:logged: (in category 'evaluating logged') ----- + evaluate: textOrString for: anObject logged: logFlag + "See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, + a Syntax Error view is created rather than notifying any requestor." + + ^self evaluate: textOrString for: anObject notifying: nil logged: logFlag! Item was added: + ----- Method: Compiler class>>evaluate:for:notifying: (in category 'evaluating') ----- + evaluate: textOrString for: anObject notifying: aController + "Compile and execute the argument, textOrString with respect to the class + of anObject. If a compilation error occurs, notify aController." + + ^ self new + evaluate: textOrString + in: nil + to: anObject + notifying: aController + ifFail: [^nil]! Item was added: + ----- Method: Compiler class>>evaluate:for:notifying:logged: (in category 'evaluating logged') ----- + evaluate: textOrString for: anObject notifying: aController logged: logFlag + "Compile and execute the argument, textOrString with respect to the class + of anObject. If a compilation error occurs, notify aController. If both + compilation and execution are successful then, if logFlag is true, log + (write) the text onto a system changes file so that it can be replayed if + necessary." + + ^ self new + evaluate: textOrString + in: nil + to: anObject + notifying: aController + ifFail: [^nil] + logged: logFlag.! Item was added: + ----- Method: Compiler class>>evaluate:in:notifying:logged: (in category 'evaluating logged') ----- + evaluate: textOrString in: anEnvironment notifying: aController logged: logFlag + "Compile and execute the argument, textOrString in anEnvironment. + If a compilation error occurs, notify aController. If both + compilation and execution are successful then, if logFlag is true, log + (write) the text onto a system changes file so that it can be replayed if + necessary." + + ^ self new + evaluate: textOrString + in: anEnvironment + notifying: aController + logged: logFlag.! Item was added: + ----- Method: Compiler class>>evaluate:logged: (in category 'evaluating logged') ----- + evaluate: textOrString logged: logFlag + "See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, + a Syntax Error view is created rather than notifying any requestor. + Compilation is carried out with respect to nil, i.e., no object." + + ^self evaluate: textOrString for: nil logged: logFlag! Item was added: + ----- Method: Compiler class>>evaluate:notifying: (in category 'evaluating') ----- + evaluate: textOrString notifying: aController + "See Compiler|evaluate:for:notifying:logged:. Compilation is carried out + with respect to nil, i.e., no object." + + ^self evaluate: textOrString for: nil notifying: aController! Item was added: + ----- Method: Compiler class>>evaluate:notifying:logged: (in category 'evaluating logged') ----- + evaluate: textOrString notifying: aController logged: logFlag + "See Compiler|evaluate:for:notifying:logged:. Compilation is carried out + with respect to nil, i.e., no object." + + ^self evaluate: textOrString for: nil notifying: aController logged: logFlag! Item was added: + ----- Method: Compiler class>>format:in:notifying: (in category 'evaluating') ----- + format: textOrStream in: aClass notifying: aRequestor + ^self new format: textOrStream in: aClass notifying: aRequestor! Item was added: + ----- Method: Compiler class>>format:in:notifying:decorated: (in category 'evaluating') ----- + format: textOrStream in: aClass notifying: aRequestor decorated: aBoolean + ^self new format: textOrStream in: aClass notifying: aRequestor decorated: aBoolean! Item was added: + ----- Method: Compiler class>>initialize (in category 'class initialization') ----- + initialize + "For the benefit of MC running a required script in the proper order." + self recompileAll.! Item was added: + ----- Method: Compiler class>>new (in category 'accessing') ----- + new + ^ super new parser: self newParser! Item was added: + ----- Method: Compiler class>>parserClass (in category 'accessing') ----- + parserClass + "Answer a parser class to use for parsing methods compiled by instances of the receiver." + + ^Parser! Item was added: + ----- Method: Compiler class>>recompileAll (in category 'utilities') ----- + recompileAll "Compiler recompileAll" + "Recompile all classes and traits in the system. + After recompilation invoke the postRecompileAction on any " + + | classesWithRecompileActions | + classesWithRecompileActions := OrderedCollection new. + Smalltalk allClassesAndTraits "This is unordered; I find that unsatisfactory and fragile, because + if there is a bug it could be difficult to reproduce. eem 10/8/2019" + do: [:classOrTrait | + classOrTrait compileAll. + (classOrTrait class includesSelector: #postRecompileAction) ifTrue: + [classesWithRecompileActions addLast: classOrTrait]] + displayingProgress:[:classOrTrait| 'Recompiling ', classOrTrait]. + + classesWithRecompileActions do: [:classOrTrait| classOrTrait postRecompileAction]! Item was added: + ----- Method: Compiler class>>recompileAllFrom: (in category 'utilities') ----- + recompileAllFrom: firstName + "Recompile all classes, starting with given name." + | classesWithRecompileActions | + classesWithRecompileActions := OrderedCollection new. + + Smalltalk allClassesDo: + [:class | + class name >= firstName ifTrue: + [Transcript show: class name; cr. + class compileAll. + (class class includesSelector: #postRecompileAction) ifTrue: + [classesWithRecompileActions addLast: class]]]. + + classesWithRecompileActions do: + [:classOrTrait| classOrTrait postRecompileAction] + + "Compiler recompileAllFrom: 'AAABodyShop'"! Item was added: + ----- Method: Compiler>>classForReceiver:context: (in category 'private') ----- + classForReceiver: receiver context: contextOrNil + "Answer the class to compile in for a receiver and aContext. + If aContext is non-nil use its receiver's class (if we use the context's + methodClass we may exclude instance variables of the receiver). + Access the class of the receiver via the mirror primitive to avoid issues with proxies." + + ^thisContext objectClass: (contextOrNil ifNil: [receiver] ifNotNil: [contextOrNil receiver])! Item was added: + ----- Method: Compiler>>compile:ifFail: (in category 'public access') ----- + compile: aCue ifFail: failBlock + "Answer a MethodNode. If the MethodNode can not be created, notify + the requestor in the contxt. If the requestor is nil, evaluate failBlock + instead. The MethodNode is the root of a parse tree. It can be told + to generate a CompiledMethod to be installed in the method dictionary + of the class specified by the context." + + ^self + compileCue: aCue + noPattern: false + ifFail: failBlock ! Item was added: + ----- Method: Compiler>>compile:in:environment:notifying:ifFail: (in category 'public access') ----- + compile: textOrStream in: aClass environment: anEnvironment notifying: aRequestor ifFail: failBlock + "Answer a MethodNode for the argument, textOrStream. If the + MethodNode can not be created, notify the argument, aRequestor; if + aRequestor is nil, evaluate failBlock instead. The MethodNode is the root + of a parse tree. It can be told to generate a CompiledMethod to be + installed in the method dictionary of the argument, aClass." + + ^self + compileCue: (CompilationCue + source: textOrStream + class: aClass + environment: anEnvironment + requestor: aRequestor) + noPattern: false + ifFail: failBlock + ! Item was added: + ----- Method: Compiler>>compile:in:notifying:ifFail: (in category 'public access') ----- + compile: textOrStream in: aClass notifying: aRequestor ifFail: failBlock + "Answer a MethodNode for the argument, textOrStream. If the + MethodNode can not be created, notify the argument, aRequestor; if + aRequestor is nil, evaluate failBlock instead. The MethodNode is the root + of a parse tree. It can be told to generate a CompiledMethod to be + installed in the method dictionary of the argument, aClass." + + ^self + compileCue: (CompilationCue + source: textOrStream + class: aClass + requestor: aRequestor) + noPattern: false + ifFail: failBlock + ! Item was added: + ----- Method: Compiler>>compileCue:noPattern:ifFail: (in category 'private') ----- + compileCue: aCue noPattern: aBoolean ifFail: failBlock + "Answer a MethodNode corresponding to cue source. + If the MethodNode can not be created, notify the cue requestor. + If the cue requestor is nil, evaluate failBlock instead. + The MethodNode is the root of a parse tree. + It can be told to generate a CompiledMethod + - either to be evaluated in cue context if aBoolean is true, with cue receiver as method receiver, + - or to be installed in the method dictionary of the target class specified by the cue if aBoolean is false." + + self setCue: aCue. + ^self translateNoPattern: aBoolean ifFail: failBlock! Item was added: + ----- Method: Compiler>>compileNoPattern:in:context:environment:notifying:ifFail: (in category 'public access') ----- + compileNoPattern: textOrStream in: aClass context: aContext environment: anEnvironment notifying: aRequestor ifFail: failBlock + "Similar to #compile:in:notifying:ifFail:, but the compiled code is + expected to be a do-it expression, with no message pattern, + and it will be in an explicit environment." + + ^self + compileCue: (CompilationCue + source: textOrStream + context: aContext + class: aClass + environment: anEnvironment + requestor: aRequestor) + noPattern: true + ifFail: failBlock + ! Item was added: + ----- Method: Compiler>>compileNoPattern:in:context:notifying:ifFail: (in category 'public access') ----- + compileNoPattern: textOrStream in: aClass context: aContext notifying: aRequestor ifFail: failBlock + "Similar to #compile:in:notifying:ifFail:, but the compiled code is + expected to be a do-it expression, with no message pattern." + + ^self + compileCue: (CompilationCue + source: textOrStream + context: aContext + class: aClass + requestor: aRequestor) + noPattern: true + ifFail: failBlock + ! Item was added: + ----- Method: Compiler>>compileNoPattern:in:notifying:ifFail: (in category 'public access') ----- + compileNoPattern: textOrStream in: aClass notifying: aRequestor ifFail: failBlock + "Similar to #compile:in:notifying:ifFail:, but the compiled code is + expected to be a do-it expression, with no message pattern." + + ^self + compileCue: (CompilationCue + source: textOrStream + class: aClass + requestor: aRequestor) + noPattern: true + ifFail: failBlock + ! Item was added: + ----- Method: Compiler>>compiledMethodFor:in:to:notifying:ifFail: (in category 'public access') ----- + compiledMethodFor: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock + "Compiles the sourceStream into a parse tree, then generates code + into a method, and answers it. If receiver is not nil, then the text can + refer to instance variables of that receiver (the Inspector uses this). + If aContext is not nil, the text can refer to temporaries in that context + (the Debugger uses this). If aRequestor is not nil, then it will receive a + notify:at: message before the attempt to evaluate is aborted." + + | methodNode method | + methodNode := self + compileNoPattern: textOrStream + in: (self classForReceiver: receiver context: aContext) + context: aContext + notifying: aRequestor + ifFail: [^failBlock value]. + method := self interactive + ifTrue: [ methodNode generateWithTempNames ] + ifFalse: [ methodNode generate ]. + ^method! Item was added: + ----- Method: Compiler>>compiledMethodFor:in:to:notifying:ifFail:logged: (in category 'public access logging') ----- + compiledMethodFor: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag + "Compiles the sourceStream into a parse tree, then generates code + into a method, and answers it. If receiver is not nil, then the text can + refer to instance variables of that receiver (the Inspector uses this). + If aContext is not nil, the text can refer to temporaries in that context + (the Debugger uses this). If aRequestor is not nil, then it will receive a + notify:at: message before the attempt to evaluate is aborted." + + | method | + method := self + compiledMethodFor: textOrStream + in: aContext + to: receiver + notifying: aRequestor + ifFail: [^failBlock value]. + logFlag ifTrue: + [SystemChangeNotifier uniqueInstance evaluated: cue stringToLog context: aContext]. + ^method! Item was added: + ----- Method: Compiler>>evaluate: (in category 'public access') ----- + evaluate: textOrString + "See evaluate:for:notifying:logged:. If a compilation error occurs, + a Syntax Error view is created rather than notifying any requestor. + Compilation is carried out with respect to nil, i.e., no object, and the + invocation is not logged." + + ^self evaluate: textOrString for: nil! Item was added: + ----- Method: Compiler>>evaluate:for: (in category 'public access') ----- + evaluate: textOrString for: anObject + "See evaluate:for:notifying:logged:. If a compilation error occurs, + a Syntax Error view is created rather than notifying any requestor." + + ^self evaluate: textOrString for: anObject notifying: nil! Item was added: + ----- Method: Compiler>>evaluate:for:logged: (in category 'public access logging') ----- + evaluate: textOrString for: anObject logged: logFlag + "See evaluate:for:notifying:logged:. If a compilation error occurs, + a Syntax Error view is created rather than notifying any requestor." + + ^self evaluate: textOrString for: anObject notifying: nil logged: logFlag! Item was added: + ----- Method: Compiler>>evaluate:for:notifying: (in category 'public access') ----- + evaluate: textOrString for: anObject notifying: aController + "Compile and execute the argument, textOrString with respect to the class + of anObject. If a compilation error occurs, notify aController." + + ^ self + evaluate: textOrString + in: nil + to: anObject + notifying: aController + ifFail: [^nil]! Item was added: + ----- Method: Compiler>>evaluate:for:notifying:logged: (in category 'public access logging') ----- + evaluate: textOrString for: anObject notifying: aController logged: logFlag + "Compile and execute the argument, textOrString with respect to the class + of anObject. If a compilation error occurs, notify aController. If both + compilation and execution are successful then, if logFlag is true, log + (write) the text onto a system changes file so that it can be replayed if + necessary." + + ^ self + evaluate: textOrString + in: nil + to: anObject + notifying: aController + ifFail: [^nil] + logged: logFlag.! Item was added: + ----- Method: Compiler>>evaluate:in:environment:notifying:ifFail:logged: (in category 'public access logging') ----- + evaluate: textOrStream in: aContext environment: anEnvironment notifying: aRequestor ifFail: failBlock logged: logFlag + "Compiles the sourceStream into a parse tree, then generates code into + a method. If aContext is not nil, the text can refer to temporaries in that + context (the Debugger uses this). If aRequestor is not nil, then it will receive + a notify:at: message before the attempt to evaluate is aborted. Finally, the + compiled method is invoked from here via withArgs:executeMethod:, hence + the system no longer creates Doit method litter on errors." + ^self + evaluateCue: (CompilationCue + source: textOrStream + context: aContext + receiver: nil + class: UndefinedObject + environment: anEnvironment + requestor: aRequestor) + ifFail: failBlock + logged: logFlag! Item was added: + ----- Method: Compiler>>evaluate:in:notifying:logged: (in category 'public access logging') ----- + evaluate: textOrString in: anEnvironment notifying: aController logged: logFlag + "Compile and execute the argument, textOrString in anEnvironment. + If a compilation error occurs, notify aController. If both + compilation and execution are successful then, if logFlag is true, log + (write) the text onto a system changes file so that it can be replayed if + necessary." + + ^self + evaluate: textOrString + in: nil + environment: anEnvironment + notifying: aController + ifFail: [^nil] + logged: logFlag! Item was added: + ----- Method: Compiler>>evaluate:in:to: (in category 'public access') ----- + evaluate: aString in: aContext to: aReceiver + "evaluate aString in the given context, and return the result. 2/2/96 sw" + ^self + evaluate: aString + in: aContext + to: aReceiver + notifying: nil + ifFail: [^ #failedDoit]! Item was added: + ----- Method: Compiler>>evaluate:in:to:environment:notifying:ifFail:logged: (in category 'public access logging') ----- + evaluate: textOrStream in: aContext to: receiver environment: anEnvironment notifying: aRequestor ifFail: failBlock logged: logFlag + "Same as #evaluate:in:to:notifying:ifFail:logged: but with an explicit environment" + ^self + evaluateCue: (CompilationCue + source: textOrStream + context: aContext + receiver: receiver + class: (self classForReceiver: receiver context: aContext) + environment: anEnvironment + requestor: aRequestor) + ifFail: failBlock + logged: logFlag! Item was added: + ----- Method: Compiler>>evaluate:in:to:notifying:ifFail: (in category 'public access') ----- + evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock + "Compiles the sourceStream into a parse tree, then generates code into + a method. If aContext is not nil, the text can refer to temporaries in that + context (the Debugger uses this). If aRequestor is not nil, then it will receive + a notify:at: message before the attempt to evaluate is aborted. Finally, the + compiled method is invoked from here via withArgs:executeMethod:, hence + the system no longer creates Doit method litter on errors." + + | theClass | + theClass := self classForReceiver: receiver context: aContext. + ^self + evaluateCue: (CompilationCue + source: textOrStream + context: aContext + receiver: receiver + class: theClass + environment: theClass environment + requestor: aRequestor) + ifFail: failBlock! Item was added: + ----- Method: Compiler>>evaluate:in:to:notifying:ifFail:logged: (in category 'public access logging') ----- + evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag + "Compiles the sourceStream into a parse tree, then generates code into + a method. If aContext is not nil, the text can refer to temporaries in that + context (the Debugger uses this). If aRequestor is not nil, then it will receive + a notify:at: message before the attempt to evaluate is aborted. Finally, the + compiled method is invoked from here via withArgs:executeMethod:, hence + the system no longer creates Doit method litter on errors." + | theClass | + theClass := self classForReceiver: receiver context: aContext. + ^self + evaluateCue: (CompilationCue + source: textOrStream + context: aContext + receiver: receiver + class: theClass + environment: theClass environment + requestor: aRequestor) + ifFail: failBlock + logged: logFlag! Item was added: + ----- Method: Compiler>>evaluate:logged: (in category 'public access logging') ----- + evaluate: textOrString logged: logFlag + "See evaluate:for:notifying:logged:. If a compilation error occurs, + a Syntax Error view is created rather than notifying any requestor. + Compilation is carried out with respect to nil, i.e., no object." + + ^self evaluate: textOrString for: nil logged: logFlag! Item was added: + ----- Method: Compiler>>evaluate:notifying: (in category 'public access') ----- + evaluate: textOrString notifying: aController + "See evaluate:for:notifying:. Compilation is carried out + with respect to nil, i.e., no object." + + ^self evaluate: textOrString for: nil notifying: aController! Item was added: + ----- Method: Compiler>>evaluate:notifying:logged: (in category 'public access logging') ----- + evaluate: textOrString notifying: aController logged: logFlag + "See evaluate:for:notifying:logged:. Compilation is carried out + with respect to nil, i.e., no object." + + ^self evaluate: textOrString for: nil notifying: aController logged: logFlag! Item was added: + ----- Method: Compiler>>evaluateCue:ifFail: (in category 'private') ----- + evaluateCue: aCue ifFail: failBlock + "Compiles the cue source into a parse tree, then generates code into + a method. Finally, the compiled method is invoked from here via withArgs:executeMethod:, hence the system no longer creates Doit method + litter on errors." + + | methodNode method value | + methodNode := self compileCue: aCue noPattern: true ifFail: [^failBlock value]. + + method := self interactive + ifTrue: [methodNode generateWithTempNames] + ifFalse: [methodNode generate]. + + value := cue receiver + withArgs: (cue context ifNil: [#()] ifNotNil: [{cue context}]) + executeMethod: method. + ^ value + ! Item was added: + ----- Method: Compiler>>evaluateCue:ifFail:logged: (in category 'private') ----- + evaluateCue: aCue ifFail: failBlock logged: logFlag + "Compiles the cue source into a parse tree, then generates code into + a method. Finally, the compiled method is invoked from here via withArgs:executeMethod:, hence the system no longer creates Doit method + litter on errors." + + | value | + value := self evaluateCue: aCue ifFail: [^failBlock value]. + logFlag ifTrue: + [SystemChangeNotifier uniqueInstance evaluated: cue stringToLog context: cue context]. + ^ value + ! Item was added: + ----- Method: Compiler>>format:in:notifying: (in category 'public access') ----- + format: textOrStream in: aClass notifying: aRequestor + "Compile a parse tree from the argument, textOrStream. Answer a string containing the original code, formatted nicely. If aBoolean is true, then decorate the resulting text with color and hypertext actions" + + | aNode | + self from: textOrStream + class: aClass + notifying: aRequestor. + aNode := self formatNoPattern: false ifFail: [^ nil]. + + "aSymbol == #colorPrint ifTrue: + [^aNode asColorizedSmalltalk80Text]." "deprecating #colorPrint in favor of Shout --Ron Spengler" + + ^aNode decompileString! Item was added: + ----- Method: Compiler>>format:in:notifying:decorated: (in category 'public access') ----- + format: textOrStream in: aClass notifying: aRequestor decorated: aBoolean + "Compile a parse tree from the argument, textOrStream. Answer a string containing the original code, formatted nicely. If aBoolean is true, then decorate the resulting text with color and hypertext actions" + | aNode | + self from: textOrStream + class: aClass + notifying: aRequestor. + aNode := self formatNoPattern: false ifFail: [^ nil]. + ^ aBoolean + ifTrue: [aNode decompileText] + ifFalse: [aNode decompileString]! Item was added: + ----- Method: Compiler>>formatNoPattern:environment: (in category 'public access') ----- + formatNoPattern: textOrStream environment: env + "Pretty-print a code snippet. Removes leading 'DoIt' and the '^' in the last statement. To be used in workspace-like tools." + + | aNode | + self setCue: (CompilationCue + source: textOrStream + environment: env). + + aNode := self formatNoPattern: true ifFail: [^ nil]. + + ^ (aNode decompileString lines allButFirst "DoIt" collect: [:ea | + ea allButFirst "tab" in: [:result | (result beginsWith: '^ ') ifTrue: [result allButFirst: 2] ifFalse: [result]]]) + joinSeparatedBy: String cr! Item was added: + ----- Method: Compiler>>formatNoPattern:ifFail: (in category 'private') ----- + formatNoPattern: noPattern ifFail: failBlock + ^(self parser + parseCue: cue + noPattern: noPattern + ifFail: [^failBlock value]) preen! Item was added: + ----- Method: Compiler>>from:class:notifying: (in category 'private') ----- + from: textOrStream class: aClass notifying: req + self setCue: + (CompilationCue + source: textOrStream + class: aClass + requestor: req) + ! Item was added: + ----- Method: Compiler>>interactive (in category 'private') ----- + interactive + "The compilation is interactive if there is a requestor and that requestor does either not care or explicitly allow interactive error correction." + + ^ cue requestor notNil + and: [(cue requestor respondsTo: #wantsInteractiveErrorCorrection) not + or: [cue requestor perform: #wantsInteractiveErrorCorrection]]! Item was added: + ----- Method: Compiler>>parse:in:notifying: (in category 'public access') ----- + parse: textOrStream in: aClass notifying: req + "Compile the argument, textOrStream, with respect to the class, aClass, and + answer the MethodNode that is the root of the resulting parse tree. Notify the + argument, req, if an error occurs. The failBlock is defaulted to an empty block." + + self from: textOrStream class: aClass notifying: req. + ^self parser + parseCue: cue + noPattern: false + ifFail: []! Item was added: + ----- Method: Compiler>>parser (in category 'public access') ----- + parser + + parser ifNil: [parser := (cue getClass ifNil: [self class]) newParser]. + ^parser! Item was added: + ----- Method: Compiler>>parser: (in category 'public access') ----- + parser: aParser + + parser := aParser! Item was added: + ----- Method: Compiler>>parserClass: (in category 'public access') ----- + parserClass: aParserClass + + parser := aParserClass new! Item was added: + ----- Method: Compiler>>setCue: (in category 'private') ----- + setCue: aCue + cue := aCue! Item was added: + ----- Method: Compiler>>translate:noPattern:ifFail: (in category 'private') ----- + translate: ignored noPattern: noPattern ifFail: failBlock + ^self translateNoPattern: noPattern ifFail: failBlock! Item was added: + ----- Method: Compiler>>translate:noPattern:ifFail:parser: (in category 'public access') ----- + translate: aStream noPattern: noPattern ifFail: failBlock parser: parser + | tree | + tree := parser + parseCue: cue + noPattern: noPattern + ifFail: [^ failBlock value]. + ^ tree! Item was added: + ----- Method: Compiler>>translateNoPattern:ifFail: (in category 'private') ----- + translateNoPattern: noPattern ifFail: failBlock + ^self parser + parseCue: cue + noPattern: noPattern + ifFail: [^failBlock value]! Item was added: + InstructionStream subclass: #Decompiler + instanceVariableNames: 'constructor method instVars tempVars constTable stack statements lastPc exit caseExits lastJumpPc lastReturnPc limit hasValue blockStackBase numLocalTemps blockStartsToTempVars tempVarCount lastJumpIfPcStack tempReadCounts' + classVariableNames: 'ArgumentFlag CascadeFlag CaseFlag IfNilFlag OtherwiseFlag' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !Decompiler commentStamp: 'nice 2/3/2011 22:54' prior: 0! + I decompile a method in three phases: + Reverser: postfix byte codes -> prefix symbolic codes (nodes and atoms) + Parser: prefix symbolic codes -> node tree (same as the compiler) + Printer: node tree -> text (done by the nodes) + + + instance vars: + + constructor <DecompilerConstructor> an auxiliary knowing how to generate Abstract Syntax Tree (node tree) + method <CompiledMethod> the method being decompiled + instVars <Array of: String> the instance variables of the class implementing method + tempVars <String | (OrderedCollection of: String)> hold the names of temporary variables (if known) + NOTE: POLYMORPHISM WILL BE RESOLVED IN #initSymbols: + constTable <Collection of: ParseNode> parse node associated with byte encoded constants (nil true false 0 1 -1 etc...) + stack <OrderedCollection of: (ParseNode | String | Integer) > multipurpose... + statements <OrderedCollection of: ParseNode> the statements of the method being decompiled + lastPc <Integer> + exit <Integer> + caseExits <OrderedCollection of: Integer> - stack of exit addresses that have been seen in the branches of caseOf:'s + lastJumpPc <Integer> + lastReturnPc <Integer> + limit <Integer> + hasValue <Boolean> + blockStackBase <Integer> + numLocaltemps <Integer | Symbol> - number of temps local to a block; also a flag indicating decompiling a block + blockStartsToTempVars <Dictionary key: Integer value: (OrderedCollection of: String)> + tempVarCount <Integer> number of temp vars used by the method + lastJumpIfPcStack <OrderedCollection of: Integer> the value of program counter just before the last encountered conditional jumps! Item was added: + ----- Method: Decompiler class>>initialize (in category 'class initialization') ----- + initialize + + CascadeFlag := 'cascade'. "A unique object" + CaseFlag := 'case'. "Ditto" + OtherwiseFlag := 'otherwise'. "Ditto" + ArgumentFlag := 'argument'. "Ditto" + IfNilFlag := 'ifNil'. "Ditto" + + "Decompiler initialize"! Item was added: + ----- Method: Decompiler>>blockForCaseTo: (in category 'control') ----- + blockForCaseTo: end + "Decompile a range of code as in statementsForCaseTo:, but return a block node." + | exprs block oldBase | + oldBase := blockStackBase. + blockStackBase := stack size. + exprs := self statementsForCaseTo: end. + block := constructor codeBlock: exprs returns: lastReturnPc = lastPc. + blockStackBase := oldBase. + lastReturnPc := -1. "So as not to mislead outer calls" + ^block! Item was added: + ----- Method: Decompiler>>blockReturnConstant: (in category 'instruction decoding') ----- + blockReturnConstant: value + + self pushConstant: value; blockReturnTop! Item was added: + ----- Method: Decompiler>>blockReturnTop (in category 'instruction decoding') ----- + blockReturnTop + "No action needed"! Item was added: + ----- Method: Decompiler>>blockTo: (in category 'control') ----- + blockTo: end + "Decompile a range of code as in statementsTo:, but return a block node. NB: end is an exclusive index." + | exprs block oldBase lastStatementOfBlockIsNil | + oldBase := blockStackBase. + blockStackBase := stack size. + exprs := self statementsTo: end. + lastStatementOfBlockIsNil := pc < method endPC and: [exprs notEmpty and: [exprs last == (constTable at: 4)]]. + lastStatementOfBlockIsNil ifTrue: + [exprs := exprs allButLast]. + block := constructor codeBlock: exprs returns: lastReturnPc = lastPc. + blockStackBase := oldBase. + lastReturnPc := -1. "So as not to mislead outer calls" + ^block! Item was added: + ----- Method: Decompiler>>case: (in category 'instruction decoding') ----- + case: dist + "statements = keyStmts CascadeFlag keyValueBlock ... keyStmts" + + | nextCase thenJump stmtStream elements b node cases otherBlock myExits | + nextCase := pc + dist. + + "Now add CaseFlag & keyValueBlock to statements" + statements addLast: stack removeLast. + "Trick: put a flag on the stack. + If it is the last case before otherwise: block, then + - there won't be a dup of caseOf: receiver before sending = + - there won't be a pop in the case handling block" + stack addLast: OtherwiseFlag. "set for next pop" + statements addLast: (self blockForCaseTo: nextCase). + + stack last == OtherwiseFlag + ifTrue: "Last case" + ["ensure jump is within block (in case thenExpr returns wierdly I guess)" + stack removeLast. "get rid of CaseFlag" + stmtStream := ReadStream on: (self popTo: stack removeLast). + + elements := OrderedCollection new. + b := OrderedCollection new. + [stmtStream atEnd] whileFalse: + [(node := stmtStream next) == CaseFlag + ifTrue: + [elements addLast: (constructor + codeMessage: (constructor codeBlock: b returns: false) + selector: (constructor codeSelector: #-> code: #macro) + arguments: (Array with: stmtStream next)). + b := OrderedCollection new] + ifFalse: [b addLast: node]]. + b size > 0 ifTrue: [self error: 'Bad cases']. + cases := constructor codeBrace: elements. + + "try find the end of the case" + myExits := caseExits removeLast: elements size. + myExits := myExits reject: [ :e | e isNil or: [ e < 0 or: [ e > method endPC ] ] ]. + thenJump := myExits isEmpty + ifTrue: [ nextCase ] + ifFalse: [ myExits max ]. + + otherBlock := self blockTo: thenJump. + stack addLast: + (constructor + codeMessage: stack removeLast + selector: (constructor codeSelector: #caseOf:otherwise: code: #macro) + arguments: (Array with: cases with: otherBlock))].! Item was added: + ----- Method: Decompiler>>checkForClosureCopy:arguments: (in category 'control') ----- + checkForClosureCopy: receiver arguments: arguments + "We just saw a closureCopy:copiedValues: message. Check for and construct a following block." + + | savePc jump | + receiver == constructor codeThisContext ifFalse: [^false]. + savePc := pc. + (jump := self interpretJump) notNil ifFalse: + [pc := savePc. + ^nil]. + "Definitely a block" + self doClosureCopyCopiedValues: arguments last "<BraceNode>" elements + numArgs: arguments first key + blockSize: jump. + ^true! Item was added: + ----- Method: Decompiler>>constructorForMethod: (in category 'private') ----- + constructorForMethod: aMethod + ^DecompilerConstructor new! Item was added: + ----- Method: Decompiler>>convertToDoLoop: (in category 'private') ----- + convertToDoLoop: blockBodyTempCounts + "If statements contains the pattern + var := startExpr. + [var <= limit] whileTrue: [...statements... var := var + incConst] + or + var := startExpr. + limit := limitExpr. + [var <= limit] whileTrue: [...statements... var := var + incConst] + then replace this by + startExpr to: limit by: incConst do: [:var | ...statements...] + and answer true." + | whileStmt incrStmt initStmt limitStmt toDoStmt | + whileStmt := statements last. + incrStmt := whileStmt arguments first statements last. + incrStmt isAssignmentNode ifFalse: + [^false]. + (self startAndLimitFor: incrStmt variable from: stack into: + [:startExpr :limitExpr| initStmt := startExpr. limitStmt := limitExpr]) + ifTrue: + [| limitInStatements | + limitInStatements := limitStmt isNil + and: [statements size > 1 + and: [self startAndLimitFor: incrStmt variable from: { stack last. (statements last: 2) first } into: + [:startExpr :limitExpr| limitStmt := limitExpr]]]. + (toDoStmt := statements last toDoFromWhileWithCounts: blockBodyTempCounts init: initStmt limit: limitStmt) ifNil: + [^false]. + limitInStatements + ifTrue: + [stack + removeLast; + addLast: toDoStmt. + statements removeLast: 2] + ifFalse: + [stack + removeLast: (limitStmt ifNil: [1] ifNotNil: [2]); + addLast: toDoStmt. + statements removeLast]] + ifFalse: + [(self startAndLimitFor: incrStmt variable from: statements allButLast into: + [:startExpr :limitExpr| initStmt := startExpr. limitStmt := limitExpr]) ifFalse: + [^false]. + (toDoStmt := statements last toDoFromWhileWithCounts: blockBodyTempCounts init: initStmt limit: limitStmt) ifNil: + [^false]. + statements + removeLast: (limitStmt ifNil: [2] ifNotNil: [3]); + addLast: toDoStmt]. + self markTemp: initStmt variable asOutOfScope: -1. "Flag arg as out of scope" + initStmt variable beBlockArg. + limitStmt ifNotNil: + [self markTemp: limitStmt variable asOutOfScope: -2. + toDoStmt arguments at: 1 put: limitStmt value]. "Flag limit as hidden" + ^true! Item was added: + ----- Method: Decompiler>>decompile:in: (in category 'public access') ----- + decompile: aSelector in: aClass + "See Decompiler|decompile:in:method:. The method is found by looking up + the message, aSelector, in the method dictionary of the class, aClass." + + ^self + decompile: aSelector + in: aClass + method: (aClass compiledMethodAt: aSelector) methodForDecompile! Item was added: + ----- Method: Decompiler>>decompile:in:method: (in category 'public access') ----- + decompile: aSelector in: aClass method: aMethod + "Answer a MethodNode that is the root of the parse tree for the + argument, aMethod, which is the CompiledMethod associated with the + message, aSelector. Variables are determined with respect to the + argument, aClass." + + ^self + decompile: aSelector + in: aClass + method: aMethod + using: (self constructorForMethod: aMethod)! Item was added: + ----- Method: Decompiler>>decompile:in:method:using: (in category 'public access') ----- + decompile: aSelector in: aClass method: aMethod using: aConstructor + + | block node | + constructor := aConstructor. + method := aMethod. + self initSymbols: aClass. "create symbol tables" + method isQuick + ifTrue: [block := self quickMethod] + ifFalse: + [stack := OrderedCollection new: method frameSize. + lastJumpIfPcStack := OrderedCollection new. + caseExits := OrderedCollection new. + statements := OrderedCollection new: 20. + numLocalTemps := 0. + self method: method pc: method initialPC. + "skip primitive error code store if necessary" + (method primitive ~= 0 and: [self skipCallPrimitive; willStore]) ifTrue: + [pc := pc + (method encoderClass bytecodeSize: self firstByte). + tempVars := tempVars asOrderedCollection]. + block := self blockTo: method endPC + 1. + stack isEmpty ifFalse: [self error: 'stack not empty']]. + node := constructor + codeMethod: aSelector + block: block + tempVars: tempVars + primitive: method primitive + class: aClass. + method primitive > 0 ifTrue: + [node removeAndRenameLastTempIfErrorCode]. + ^node preen! Item was added: + ----- Method: Decompiler>>decompileBlock: (in category 'public access') ----- + decompileBlock: aBlock + "Decompile aBlock, returning the result as a BlockNode. + Show temp names from source if available." + "Decompiler new decompileBlock: [3 + 4]" + "[3 + 4] decompile decompileString" + aBlock method decompileWithTemps + ifNil: [^nil] + ifNotNil: + [:methodNode| + methodNode nodesDo: + (aBlock isFullBlock + ifTrue: [[:node| (node pc isVariableBinding and: [node pc key == aBlock method]) ifTrue: [^node]]] + ifFalse: [[:node| node pc = aBlock startpc ifTrue: [^node]]])]. + ^self error: 'cannot find block node matching aBlock'! Item was added: + ----- Method: Decompiler>>directedSuperSend:numArgs: (in category 'instruction decoding') ----- + directedSuperSend: selector numArgs: numArgs + stack removeLast. "Discard the pushed class." + ^self send: selector super: true numArgs: numArgs! Item was added: + ----- Method: Decompiler>>doClosureCopy:copiedValues: (in category 'control') ----- + doClosureCopy: aCompiledBlock copiedValues: blockCopiedValues + "implementation note: must be invoked on a copy because it modifies states" + | savedPC blockArgs blockTemps blockTempsOffset block mark | + numLocalTemps := aCompiledBlock numTemps - aCompiledBlock numArgs - blockCopiedValues size. + blockTempsOffset := aCompiledBlock numArgs + blockCopiedValues size. + (blockStartsToTempVars notNil "implies we were intialized with temp names." + and: [blockStartsToTempVars includesKey: aCompiledBlock]) + ifTrue: + [tempVars := blockStartsToTempVars at: aCompiledBlock] + ifFalse: + [blockArgs := (1 to: aCompiledBlock numArgs) collect: + [:i| (constructor + codeTemp: i - 1 + named: 't', (tempVarCount + i) printString) + beBlockArg]. + blockTemps := (1 to: numLocalTemps) collect: + [:i| constructor + codeTemp: i + blockTempsOffset - 1 + named: 't', (tempVarCount + i + aCompiledBlock numArgs) printString]. + tempVars := blockArgs, blockCopiedValues, blockTemps]. + tempVarCount := tempVarCount + aCompiledBlock numArgs + numLocalTemps. + lastJumpIfPcStack := OrderedCollection new. + caseExits := OrderedCollection new. + statements := OrderedCollection new: 20. + savedPC := pc. + self method: (method := aCompiledBlock) pc: aCompiledBlock initialPC. + mark := stack size. + block := self blockTo: aCompiledBlock endPC + 1. + mark = stack size ifFalse: [self error: 'block did alter the stack']. + ^((constructor + codeArguments: (tempVars copyFrom: 1 to: aCompiledBlock numArgs) + temps: (tempVars copyFrom: blockTempsOffset + 1 to: blockTempsOffset + numLocalTemps) + block: block) + pc: aCompiledBlock -> savedPC; "c.f. BytecodeEncoder>>pc" + yourself).! Item was added: + ----- Method: Decompiler>>doClosureCopyCopiedValues:numArgs:blockSize: (in category 'control') ----- + doClosureCopyCopiedValues: blockCopiedValues numArgs: numArgs blockSize: blockSize + | startpc savedTemps savedTempVarCount savedNumLocalTemps + jump blockArgs blockTemps blockTempsOffset block | + savedTemps := tempVars. + savedTempVarCount := tempVarCount. + savedNumLocalTemps := numLocalTemps. + jump := blockSize + (startpc := pc). + numLocalTemps := BlockLocalTempCounter + tempCountForBlockStartingAt: pc + in: method. + blockTempsOffset := numArgs + blockCopiedValues size. + (blockStartsToTempVars notNil "implies we were intialized with temp names." + and: [blockStartsToTempVars includesKey: pc]) + ifTrue: + [tempVars := blockStartsToTempVars at: pc] + ifFalse: + [blockArgs := (1 to: numArgs) collect: + [:i| (constructor + codeTemp: i - 1 + named: 't', (tempVarCount + i) printString) + beBlockArg]. + blockTemps := (1 to: numLocalTemps) collect: + [:i| constructor + codeTemp: i + blockTempsOffset - 1 + named: 't', (tempVarCount + i + numArgs) printString]. + tempVars := blockArgs, blockCopiedValues, blockTemps]. + numLocalTemps timesRepeat: + [self interpretNextInstructionFor: self. + stack removeLast]. + tempVarCount := tempVarCount + numArgs + numLocalTemps. + block := self blockTo: jump. + stack addLast: ((constructor + codeArguments: (tempVars copyFrom: 1 to: numArgs) + temps: (tempVars copyFrom: blockTempsOffset + 1 to: blockTempsOffset + numLocalTemps) + block: block) + pc: startpc; + yourself). + tempVars := savedTemps. + tempVarCount := savedTempVarCount. + numLocalTemps := savedNumLocalTemps! Item was added: + ----- Method: Decompiler>>doDup (in category 'instruction decoding') ----- + doDup + stack last == CaseFlag + ifTrue: + ["We are in the process of decompiling a caseOf:" + stack addLast: CaseFlag. + ^self]. + stack last == CascadeFlag + ifFalse: + ["Save position and mark cascade" + stack addLast: statements size. + stack addLast: CascadeFlag]. + stack addLast: CascadeFlag! Item was added: + ----- Method: Decompiler>>doPop (in category 'instruction decoding') ----- + doPop + + stack isEmpty ifTrue: + ["Ignore pop in first leg of ifNil for value" + ^ self]. + stack last == OtherwiseFlag + ifTrue: [stack removeLast] + ifFalse: [statements addLast: stack removeLast].! Item was added: + ----- Method: Decompiler>>doStore: (in category 'instruction decoding') ----- + doStore: stackOrBlock + "Only called internally, not from InstructionStream. StackOrBlock is stack + for store, statements for storePop." + + | var expr | + var := stack removeLast. + expr := stack removeLast. + stackOrBlock addLast: (expr == ArgumentFlag + ifTrue: [var] + ifFalse: [constructor codeAssignTo: var value: expr])! Item was added: + ----- Method: Decompiler>>initSymbols: (in category 'initialize-release') ----- + initSymbols: aClass + constructor method: method class: aClass literals: method literals. + constTable := constructor codeConstants. + instVars := Array new: aClass instSize. + tempVarCount := method numTemps. + "(tempVars isNil + and: [method holdsTempNames]) ifTrue: + [tempVars := method tempNamesString]." + tempVars isString + ifTrue: + [blockStartsToTempVars := self mapFromBlockKeysIn: method + toTempVarsFrom: tempVars + constructor: constructor. + tempVars := blockStartsToTempVars at: method initialPC] + ifFalse: + [| namedTemps | + namedTemps := tempVars ifNil: [(1 to: tempVarCount) collect: [:i| 't', i printString]]. + tempVars := (1 to: tempVarCount) collect: + [:i | i <= namedTemps size + ifTrue: [constructor codeTemp: i - 1 named: (namedTemps at: i)] + ifFalse: [constructor codeTemp: i - 1]]]. + 1 to: method numArgs do: + [:i| + (tempVars at: i) beMethodArg]. + tempReadCounts := Dictionary new! Item was added: + ----- Method: Decompiler>>interpretNextInstructionFor: (in category 'private') ----- + interpretNextInstructionFor: client + + | code varNames | + + "Change false here will trace all state in Transcript." + true ifTrue: [^super interpretNextInstructionFor: client]. + + varNames := self class allInstVarNames. + code := (self method at: pc) radix: 16. + Transcript cr; cr; print: pc; space; nextPutAll: '<' , code, '>'. + (varNames indexOf: 'stack') to: varNames size do: + [:i | + i <= 10 ifTrue: [Transcript cr] ifFalse: [Transcript space; space]. + Transcript nextPutAll: (varNames at: i); nextPutAll: ': '; print: (self instVarAt: i)]. + Transcript flush. + ^super interpretNextInstructionFor: client! Item was added: + ----- Method: Decompiler>>jump: (in category 'instruction decoding') ----- + jump: dist + | blockBody destPc nextPC | + destPc := pc + dist. + (lastJumpIfPcStack isEmpty or: [dist < 0 and: [destPc > lastJumpIfPcStack last]]) + ifTrue: + ["Rule: aBackward jump not crossing a Bfp/Btp must be a repeat" + nextPC := pc. + pc := destPc. + blockBody := self statementsTo: lastPc. + blockBody size timesRepeat: [statements removeLast]. + pc := nextPC. + statements addLast: + (constructor + codeMessage: (constructor codeBlock: blockBody returns: false) + selector: (constructor + codeSelector: #repeat + code: #macro) + arguments: #()). + ] + ifFalse: + [exit := destPc. + lastJumpPc := lastPc]! Item was added: + ----- Method: Decompiler>>jump:if: (in category 'instruction decoding') ----- + jump: dist if: condition + + | savePc sign elsePc elseStart end cond ifExpr thenBlock elseBlock + thenJump elseJump condHasValue isIfNil saveStack | + lastJumpIfPcStack addLast: lastPc. + stack last == CaseFlag ifTrue: [^ [self case: dist] ensure: [lastJumpIfPcStack removeLast]]. + elsePc := lastPc. + elseStart := pc + dist. + end := limit. + "Check for bfp-jmp to invert condition. + Don't be fooled by a loop with a null body." + sign := condition. + savePc := pc. + self interpretJump ifNotNil: + [:elseDist| + (elseDist >= 0 and: [elseStart = pc]) ifTrue: + [sign := sign not. elseStart := pc + elseDist]]. + pc := savePc. + ifExpr := stack removeLast. + (isIfNil := stack size > 0 and: [stack last == IfNilFlag]) ifTrue: + [stack removeLast]. + saveStack := stack. + stack := OrderedCollection new. + thenBlock := self blockTo: elseStart. + condHasValue := hasValue or: [isIfNil]. + "ensure jump is within block (in case thenExpr returns)" + thenJump := exit <= end ifTrue: [exit] ifFalse: [elseStart]. + "if jump goes back, then it's a loop" + thenJump < elseStart + ifTrue: + [| blockBody blockArgs savedReadCounts blockBodyReadCounts selector | + "Must be a while loop... + thenJump will jump to the beginning of the while expr. In the case of while's + with a block in the condition, the while expr should include more than just + the last expression: find all the statements needed by searching for the node + with the relevant pc." + stack := saveStack. + savedReadCounts := tempReadCounts copy. + pc := thenJump. + blockBody := self statementsTo: elsePc. + blockBodyReadCounts := tempReadCounts. + savedReadCounts keysAndValuesDo: + [:temp :count| + blockBodyReadCounts at: temp put: (blockBodyReadCounts at: temp) - count]. + tempReadCounts := savedReadCounts. + "discard unwanted statements from block" + blockBody size - 1 timesRepeat: [statements removeLast]. + blockArgs := thenBlock statements = constructor codeEmptyBlock statements + ifTrue: [#()] + ifFalse: [{ thenBlock }]. + selector := blockArgs isEmpty + ifTrue: [sign ifTrue: [#whileFalse] ifFalse: [#whileTrue]] + ifFalse: [sign ifTrue: [#whileFalse:] ifFalse: [#whileTrue:]]. + statements addLast: + (constructor + codeMessage: (constructor codeBlock: blockBody returns: false) + selector: (constructor codeSelector: selector code: #macro) + arguments: blockArgs). + pc := elseStart. + selector == #whileTrue: ifTrue: + [self convertToDoLoop: blockBodyReadCounts]] + ifFalse: + ["Must be a conditional..." + elseBlock := self blockTo: thenJump. + elseJump := exit. + "if elseJump is backwards, it is not part of the elseExpr" + elseJump < elsePc ifTrue: + [pc := lastPc]. + cond := isIfNil + ifTrue: + [constructor + codeMessage: ifExpr ifNilReceiver + selector: (constructor + codeSelector: (sign ifTrue: [#ifNotNil:] ifFalse: [#ifNil:]) + code: #macro) + arguments: (Array with: thenBlock)] + ifFalse: + [(sign + ifTrue: [{elseBlock. thenBlock}] + ifFalse: [{thenBlock. elseBlock}]) in: + [:args | + (constructor + decodeIfNilWithReceiver: ifExpr + selector: #ifTrue:ifFalse: + arguments: args + tempReadCounts: tempReadCounts) ifNil: + [constructor + codeMessage: ifExpr + selector: (constructor codeSelector: #ifTrue:ifFalse: code: #macro) + arguments: args]]]. + stack := saveStack. + condHasValue + ifTrue: [stack addLast: cond] + ifFalse: [statements addLast: cond]]. + lastJumpIfPcStack removeLast.! Item was added: + ----- Method: Decompiler>>mapFromBlockKeysIn:toTempVarsFrom:constructor: (in category 'initialize-release') ----- + mapFromBlockKeysIn: aMethod toTempVarsFrom: schematicTempNamesString constructor: aDecompilerConstructor + "Answer a (n Identity) Dictionary from block start key to sequence of TermpVarNode & RemoteTempVarNode" + | startMap tempMap | + "This rather odd construct is to avoid recursion if we used aMethod methodNode startKeysToBlockExtents, + which will invoke this Decompiler if a method has no source." + startMap := (DebuggerMethodMap + forMethod: aMethod + methodNode: nil) startKeysToBlockExtents. + tempMap := aMethod + mapFromBlockKeys: (startMap keys asArray sort: [:a :b| (startMap at: a) first <= (startMap at: b) first]) + toSchematicTemps: schematicTempNamesString. + tempMap keysAndValuesDo: + [:startKey :tempNameTupleVector| + tempNameTupleVector isEmpty ifFalse: + [| subMap numTemps tempVector | + subMap := Dictionary new. + "Find how many temp slots there are (direct & indirect temp vectors) + and for each indirect temp vector find how big it is." + tempNameTupleVector do: + [:tuple| + tuple last isArray + ifTrue: + [subMap at: tuple last first put: tuple last last. + numTemps := tuple last first] + ifFalse: + [numTemps := tuple last]]. + "create the temp vector for this scope level." + tempVector := Array new: numTemps. + "fill it in with any indirect temp vectors" + subMap keysAndValuesDo: + [:index :size| + tempVector at: index put: (Array new: size)]. + "fill it in with temp nodes." + tempNameTupleVector do: + [:tuple| | itv | + tuple last isArray + ifTrue: + [itv := tempVector at: tuple last first. + itv at: tuple last last + put: (aDecompilerConstructor + codeTemp: tuple last last - 1 + named: tuple first)] + ifFalse: + [tempVector + at: tuple last + put: (aDecompilerConstructor + codeTemp: tuple last - 1 + named: tuple first)]]. + "replace any indirect temp vectors with proper RemoteTempVectorNodes" + subMap keysAndValuesDo: + [:index :size| + tempVector + at: index + put: (aDecompilerConstructor + codeRemoteTemp: index + remoteTemps: (tempVector at: index))]. + "and update the entry in the map" + tempMap at: startKey put: tempVector]]. + ^tempMap! Item was added: + ----- Method: Decompiler>>markTemp:asOutOfScope: (in category 'private') ----- + markTemp: tempVarNode asOutOfScope: scopeFlag + tempVarNode scope: scopeFlag. + tempReadCounts removeKey: tempVarNode ifAbsent: []! Item was added: + ----- Method: Decompiler>>methodRefersOnlyOnceToTemp: (in category 'private') ----- + methodRefersOnlyOnceToTemp: offset + | nRefs byteCode extension scanner | + nRefs := 0. + offset <= 15 + ifTrue: + [byteCode := 16 + offset. + (InstructionStream on: method) scanFor: + [:instr | instr = byteCode ifTrue: [nRefs := nRefs + 1]. + nRefs > 1]] + ifFalse: + [extension := 64 + offset. + scanner := InstructionStream on: method. + scanner scanFor: + [:instr | (instr = 128 and: [scanner followingByte = extension]) + ifTrue: [nRefs := nRefs + 1]. + nRefs > 1]]. + ^ nRefs = 1 + ! Item was added: + ----- Method: Decompiler>>methodReturnConstant: (in category 'instruction decoding') ----- + methodReturnConstant: value + + self pushConstant: value; methodReturnTop! Item was added: + ----- Method: Decompiler>>methodReturnReceiver (in category 'instruction decoding') ----- + methodReturnReceiver + + self pushReceiver; methodReturnTop! Item was added: + ----- Method: Decompiler>>methodReturnTop (in category 'instruction decoding') ----- + methodReturnTop + | last | + last := stack removeLast "test test" asReturnNode. + stack size > blockStackBase "get effect of elided pop before return" + ifTrue: [statements addLast: stack removeLast]. + exit := pc. + lastJumpPc := lastReturnPc := lastPc. + statements addLast: last! Item was added: + ----- Method: Decompiler>>popIntoLiteralVariable: (in category 'instruction decoding') ----- + popIntoLiteralVariable: value + + self pushLiteralVariable: value; doStore: statements! Item was added: + ----- Method: Decompiler>>popIntoReceiverVariable: (in category 'instruction decoding') ----- + popIntoReceiverVariable: offset + + self pushReceiverVariable: offset; doStore: statements! Item was added: + ----- Method: Decompiler>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- + popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex + self pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex; doStore: statements! Item was added: + ----- Method: Decompiler>>popIntoTemporaryVariable: (in category 'instruction decoding') ----- + popIntoTemporaryVariable: offset + | maybeTVTag tempVector start | + maybeTVTag := stack last. + ((maybeTVTag isMemberOf: Association) + and: [maybeTVTag key == #pushNewArray]) ifTrue: + [blockStartsToTempVars "implies we were intialized with temp names." + ifNotNil: "Use the provided temps" + [self assert: ((tempVector := tempVars at: offset + 1 ifAbsent: [ParseNode basicNew]) isTemp + and: [tempVector isIndirectTempVector + and: [tempVector remoteTemps size = maybeTVTag value size]])] + ifNil: "Synthesize some remote temps" + [tempVector := maybeTVTag value. + offset + 1 <= tempVars size + ifTrue: + [start := 2. + tempVector at: 1 put: (tempVars at: offset + 1)] + ifFalse: + [tempVars := (Array new: offset + 1) + replaceFrom: 1 + to: tempVars size + with: tempVars. + start := 1]. + start to: tempVector size do: + [:i| + tempVector + at: i + put: (constructor + codeTemp: numLocalTemps + offset + i - 1 + named: 't', (tempVarCount + i) printString)]. + tempVars at: offset + 1 put: (constructor codeRemoteTemp: offset + 1 remoteTemps: tempVector)]. + tempVarCount := tempVarCount + maybeTVTag value size. + stack removeLast. + ^self]. + stack addLast: (offset >= tempVars size + ifTrue: "Handle the case of chained LiteralVariableBinding assigments" + [stack at: (offset + 1 - tempVars size)] + ifFalse: "A regular argument or temporary" + [tempVars at: offset + 1]). + self doStore: statements! Item was added: + ----- Method: Decompiler>>popTo: (in category 'private') ----- + popTo: oldPos + + | t | + t := Array new: statements size - oldPos. + (t size to: 1 by: -1) do: + [:i | t at: i put: statements removeLast]. + ^t! Item was added: + ----- Method: Decompiler>>pushActiveContext (in category 'instruction decoding') ----- + pushActiveContext + + stack addLast: constructor codeThisContext! Item was added: + ----- Method: Decompiler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') ----- + pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize + | copiedValues | + copiedValues := ((1 to: numCopied) collect: [:ign| stack removeLast]) reversed. + self doClosureCopyCopiedValues: copiedValues numArgs: numArgs blockSize: blockSize! Item was added: + ----- Method: Decompiler>>pushConsArrayWithElements: (in category 'instruction decoding') ----- + pushConsArrayWithElements: numElements + | array | + array := Array new: numElements. + numElements to: 1 by: -1 do: + [:i| + array at: i put: stack removeLast]. + stack addLast: (constructor codeBrace: array)! Item was added: + ----- Method: Decompiler>>pushConstant: (in category 'instruction decoding') ----- + pushConstant: value + + | node | + node := value == true ifTrue: [constTable at: 2] + ifFalse: [value == false ifTrue: [constTable at: 3] + ifFalse: [value == nil ifTrue: [constTable at: 4] + ifFalse: [constructor codeAnyLiteral: value]]]. + stack addLast: node! Item was added: + ----- Method: Decompiler>>pushFullClosure:numCopied: (in category 'instruction decoding') ----- + pushFullClosure: aCompiledBlock numCopied: numCopied + | copiedValues | + copiedValues := ((1 to: numCopied) collect: [:ign| stack removeLast]) reversed. + stack addLast: (self shallowCopy doClosureCopy: aCompiledBlock copiedValues: copiedValues)! Item was added: + ----- Method: Decompiler>>pushLiteralVariable: (in category 'instruction decoding') ----- + pushLiteralVariable: assoc + + stack addLast: (constructor codeAnyLitInd: assoc)! Item was added: + ----- Method: Decompiler>>pushNewArrayOfSize: (in category 'instruction decoding') ----- + pushNewArrayOfSize: size + stack addLast: #pushNewArray -> (Array new: size)! Item was added: + ----- Method: Decompiler>>pushReceiver (in category 'instruction decoding') ----- + pushReceiver + + stack addLast: (constTable at: 1)! Item was added: + ----- Method: Decompiler>>pushReceiverVariable: (in category 'instruction decoding') ----- + pushReceiverVariable: offset + + | var | + (var := instVars at: offset + 1 ifAbsent: []) == nil + ifTrue: + ["Not set up yet" + var := constructor codeInst: offset. + instVars size < (offset + 1) ifTrue: [ + instVars := (Array new: offset + 1) + replaceFrom: 1 to: instVars size with: instVars; yourself ]. + instVars at: offset + 1 put: var]. + stack addLast: var! Item was added: + ----- Method: Decompiler>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- + pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex + stack addLast: ((tempVars at: tempVectorIndex + 1) remoteTemps at: remoteTempIndex + 1)! Item was added: + ----- Method: Decompiler>>pushSpecialConstant: (in category 'instruction decoding') ----- + pushSpecialConstant: value + ^self pushConstant: value! Item was added: + ----- Method: Decompiler>>pushTemporaryVariable: (in category 'instruction decoding') ----- + pushTemporaryVariable: offset + | node | + offset >= tempVars size + ifTrue: "Handle the case of chained LiteralVariableBinding assigments" + [self halt. + node := stack at: offset + 1 - tempVars size] + ifFalse: "A regular argument or temporary" + [node := tempVars at: offset + 1. + node isArg ifFalse: "count temp reads for the whileTrue: => to:do: transformation." + [tempReadCounts at: node put: (tempReadCounts at: node ifAbsent: [0]) + 1]]. + stack addLast: node! Item was added: + ----- Method: Decompiler>>quickMethod (in category 'private') ----- + quickMethod + | | + method isReturnSpecial + ifTrue: [^ constructor codeBlock: + (Array with: (constTable at: method primitive - 255)) returns: true]. + method isReturnField + ifTrue: [^ constructor codeBlock: + (Array with: (constructor codeInst: method returnField)) returns: true]. + self error: 'improper short method'! Item was added: + ----- Method: Decompiler>>send:super:numArgs: (in category 'instruction decoding') ----- + send: selector super: superFlag numArgs: numArgs + + | args rcvr selNode msgNode messages | + args := Array new: numArgs. + (numArgs to: 1 by: -1) do: + [:i | args at: i put: stack removeLast]. + rcvr := stack removeLast. + superFlag ifTrue: [rcvr := constructor codeSuper]. + selNode := constructor codeAnySelector: selector. + rcvr == CaseFlag + ifTrue: + [| cases stmtStream elements node b | + selector == #= ifTrue: + [" = signals a case statement..." + statements addLast: args first. + stack addLast: rcvr. "restore CaseFlag" + ^ self]. + selector = #caseError ifFalse: [self error: 'unexpected message send while decompiling a caseOf:']. + stmtStream := ReadStream on: (self popTo: stack removeLast). + + elements := OrderedCollection new. + b := OrderedCollection new. + [stmtStream atEnd] whileFalse: + [(node := stmtStream next) == CaseFlag + ifTrue: + [elements addLast: (constructor + codeMessage: (constructor codeBlock: b returns: false) + selector: (constructor codeSelector: #-> code: #macro) + arguments: (Array with: stmtStream next)). + b := OrderedCollection new] + ifFalse: [b addLast: node]]. + b size > 0 ifTrue: [self error: 'Bad cases']. + cases := constructor codeBrace: elements. + + stack addLast: + (constructor + codeMessage: stack removeLast + selector: (constructor codeSelector: #caseOf: code: #macro) + arguments: (Array with: cases)). + ^self]. + rcvr == CascadeFlag + ifTrue: + ["May actually be a cascade or an ifNil: for value." + self willJumpIfFalse + ifTrue: "= generated by a case macro" + [selector == #= ifTrue: + [" = signals a case statement..." + statements addLast: args first. + stack removeLast; addLast: CaseFlag; addLast: CaseFlag. "Properly mark the case statement" + ^ self]. + selector == #== ifTrue: + [" == signals an ifNil: for value..." + stack removeLast; removeLast. + rcvr := stack removeLast. + stack addLast: IfNilFlag; + addLast: (constructor + codeMessage: rcvr + selector: selNode + arguments: args). + ^ self]] + ifFalse: + [(self willJumpIfTrue and: [selector == #==]) ifTrue: + [" == signals an ifNotNil: for value..." + stack removeLast; removeLast. + rcvr := stack removeLast. + stack addLast: IfNilFlag; + addLast: (constructor + codeMessage: rcvr + selector: selNode + arguments: args). + ^ self]]. + msgNode := constructor + codeCascadedMessage: selNode + arguments: args. + stack last == CascadeFlag ifFalse: + ["Last message of a cascade" + statements addLast: msgNode. + messages := self popTo: stack removeLast. "Depth saved by first dup" + msgNode := constructor + codeCascade: stack removeLast + messages: messages]] + ifFalse: + [msgNode := constructor + codeMessage: rcvr + selector: selNode + arguments: args]. + stack addLast: msgNode! Item was added: + ----- Method: Decompiler>>sendSpecial:numArgs: (in category 'instruction decoding') ----- + sendSpecial: selector numArgs: numArgs + ^self send: selector super: false numArgs: numArgs! Item was added: + ----- Method: Decompiler>>startAndLimitFor:from:into: (in category 'private') ----- + startAndLimitFor: incrVar from: aStack into: binaryBlock + "If incrVar matches the increment of a whileLoop at the end of statements + evaluate binaryBlock with the init statement for incrVar and the init statement + for the block's limit, if any, and answer true. Otherwise answer false. Used to + help convert whileTrue: loops into to:[by:]do: loops." + | guard initExpr limitInit size | + ((size := aStack size) >= 1 + and: [(initExpr := aStack at: size) ~~ CaseFlag] + and: [initExpr isAssignmentNode]) ifFalse: + [^false]. + initExpr variable == incrVar ifTrue: + [binaryBlock value: initExpr value: nil. + ^true]. + limitInit := initExpr. + (size >= 2 + and: [(initExpr := aStack at: size - 1) isAssignmentNode + and: [initExpr variable == incrVar + and: [(guard := statements last receiver) isBlockNode + and: [guard statements size = 1 + and: [(guard := guard statements first) isMessageNode + and: [guard receiver == incrVar + and: [guard arguments first == limitInit variable]]]]]]]) ifTrue: + [binaryBlock value: initExpr value: limitInit. + ^true]. + ^false! Item was added: + ----- Method: Decompiler>>statementsForCaseTo: (in category 'control') ----- + statementsForCaseTo: end + "Decompile the method from pc up to end and return an array of + expressions. If at run time this block will leave a value on the stack, + set hasValue to true. If the block ends with a jump or return, set exit + to the destination of the jump, or the end of the method; otherwise, set + exit = end. Leave pc = end. + Note that stack initially contains a OtherwiseFlag which will be removed by + a subsequent Pop instruction, so adjust the StackPos accordingly." + + | blockPos stackPos | + blockPos := statements size. + stackPos := stack size - 1. "Adjust for OtherwiseFlag" + [pc < end] + whileTrue: + [lastPc := pc. limit := end. "for performs" + self interpretNextInstructionFor: self]. + "If there is an additional item on the stack, it will be the value + of this block." + (hasValue := stack size > stackPos) + ifTrue: + [stack last == OtherwiseFlag + ifFalse: [ statements addLast: stack removeLast] ]. + lastJumpPc = lastPc ifFalse: [exit := pc]. + caseExits add: exit. + ^self popTo: blockPos! Item was added: + ----- Method: Decompiler>>statementsTo: (in category 'control') ----- + statementsTo: end + "Decompile the method from pc up to end and return an array of + expressions. If at run time this block will leave a value on the stack, + set hasValue to true. If the block ends with a jump or return, set exit + to the destination of the jump, or the end of the method; otherwise, set + exit = end. Leave pc = end." + + | encoderClass blockPos stackPos localLastPC | + encoderClass := method encoderClass. + blockPos := statements size. + stackPos := stack size. + [pc < end] + whileTrue: + [lastPc := localLastPC := pc. limit := end. "for performs" + "If you want instrumentation replace the following statement with this one, + and edit the implementation: + self interpretNextInstructionFor: self" + encoderClass interpretNextInstructionFor: self in: self]. + "If there is an additional item on the stack, it will be the value + of this block." + (hasValue := stack size > stackPos) + ifTrue: + [statements addLast: stack removeLast]. + lastJumpPc = lastPc ifFalse: [exit := pc]. + ^self popTo: blockPos! Item was added: + ----- Method: Decompiler>>storeIntoLiteralVariable: (in category 'instruction decoding') ----- + storeIntoLiteralVariable: assoc + + self pushLiteralVariable: assoc; doStore: stack! Item was added: + ----- Method: Decompiler>>storeIntoReceiverVariable: (in category 'instruction decoding') ----- + storeIntoReceiverVariable: offset + + self pushReceiverVariable: offset; doStore: stack! Item was added: + ----- Method: Decompiler>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- + storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex + self pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex; doStore: stack! Item was added: + ----- Method: Decompiler>>storeIntoTemporaryVariable: (in category 'instruction decoding') ----- + storeIntoTemporaryVariable: offset + stack addLast: (offset >= tempVars size + ifTrue: "Handle the case of chained LiteralVariableBinding assigments" + [stack at: (offset + 1 - tempVars size)] + ifFalse: "A regular argument or temporary" + [tempVars at: offset + 1]). + self doStore: stack! Item was added: + ----- Method: Decompiler>>tempAt: (in category 'public access') ----- + tempAt: offset + "Needed by BraceConstructor<PopIntoTemporaryVariable" + + ^tempVars at: offset + 1! Item was added: + ----- Method: Decompiler>>withTempNames: (in category 'initialize-release') ----- + withTempNames: tempNames "<Array|String>" + "Optionally initialize the temp names to be used when decompiling. + For backward-copmpatibility, if tempNames is an Array it is a single + vector of temp names, probably for a blue-book-compiled method. + If tempNames is a string it is a schematic string that encodes the + layout of temp vars in the method and any closures/blocks within it. + Decoding encoded tempNames is done in decompile:in:method:using: + which has the method from which to derive blockStarts. + See e.g. BytecodeEncoder>>schematicTempNamesString for syntax." + tempVars := tempNames! Item was added: + ParseNode subclass: #DecompilerConstructor + instanceVariableNames: 'method instVars nArgs literalValues tempVars' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !DecompilerConstructor commentStamp: '<historical>' prior: 0! + I construct the node tree for a Decompiler.! Item was added: + ----- Method: DecompilerConstructor>>accept: (in category 'visiting') ----- + accept: aVisitor + "I am not really a ParseNode. Only here to access constants defined in parseNode." + self shouldNotImplement! Item was added: + ----- Method: DecompilerConstructor>>codeAnyLitInd: (in category 'constructor') ----- + codeAnyLitInd: association + + ^LiteralVariableNode new + name: association key + key: association + index: nil + type: LdLitIndType! Item was added: + ----- Method: DecompilerConstructor>>codeAnyLiteral: (in category 'constructor') ----- + codeAnyLiteral: value + + ^LiteralNode new + key: value + index: 0 + type: LdLitType! Item was added: + ----- Method: DecompilerConstructor>>codeAnySelector: (in category 'constructor') ----- + codeAnySelector: selector + + ^SelectorNode new + key: selector + index: nil + type: SendType! Item was added: + ----- Method: DecompilerConstructor>>codeArguments:temps:block: (in category 'constructor') ----- + codeArguments: args temps: temps block: block + block + arguments: args; + temporaries: temps. + ^block! Item was added: + ----- Method: DecompilerConstructor>>codeAssignTo:value: (in category 'constructor') ----- + codeAssignTo: variable value: expression + + ^AssignmentNode new variable: variable value: expression! Item was added: + ----- Method: DecompilerConstructor>>codeBlock:returns: (in category 'constructor') ----- + codeBlock: statements returns: returns + ^ BlockNode statements: statements returns: returns! Item was added: + ----- Method: DecompilerConstructor>>codeBrace: (in category 'constructor') ----- + codeBrace: elements + + ^BraceNode new elements: elements! Item was added: + ----- Method: DecompilerConstructor>>codeCascade:messages: (in category 'constructor') ----- + codeCascade: receiver messages: messages + + ^ (BraceNode new matchBraceStreamReceiver: receiver messages: messages) + ifNil: [CascadeNode new receiver: receiver messages: messages]! Item was added: + ----- Method: DecompilerConstructor>>codeCascadedMessage:arguments: (in category 'constructor') ----- + codeCascadedMessage: selector arguments: arguments + + ^self + codeMessage: nil + selector: selector + arguments: arguments! Item was added: + ----- Method: DecompilerConstructor>>codeConstants (in category 'constructor') ----- + codeConstants + "Answer with an array of the objects representing self, true, false, nil, + -1, 0, 1, 2." + + ^(Array with: NodeSelf with: NodeTrue with: NodeFalse with: NodeNil) + , ((-1 to: 2) collect: [:i | LiteralNode new key: i code: LdMinus1 + i + 1])! Item was added: + ----- Method: DecompilerConstructor>>codeEmptyBlock (in category 'constructor') ----- + codeEmptyBlock + ^ BlockNode withJust: NodeNil! Item was added: + ----- Method: DecompilerConstructor>>codeInst: (in category 'constructor') ----- + codeInst: index + + ^InstanceVariableNode new + name: (instVars at: index + 1 ifAbsent: ['unknown', index asString]) + index: index + 1! Item was added: + ----- Method: DecompilerConstructor>>codeMessage:selector:arguments: (in category 'constructor') ----- + codeMessage: receiver selector: selector arguments: arguments + | symbol | + symbol := selector key. + (self + decodeLiteralVariableValueDereferenceWithReceiver: receiver + selector: symbol + arguments: arguments) ifNotNil: [:node| ^node]. + + ^MessageNode new + receiver: receiver selector: selector + arguments: arguments + precedence: symbol precedence! Item was added: + ----- Method: DecompilerConstructor>>codeMethod:block:tempVars:primitive:class: (in category 'constructor') ----- + codeMethod: selector block: block tempVars: vars primitive: primitive class: class + + | blockNode selectorNode visibleTemps invisibleTemps arguments temporaries properties | + selectorNode := self codeSelector: selector code: nil. + tempVars := vars. + visibleTemps := OrderedCollection new. + invisibleTemps := OrderedCollection new. + tempVars do: [:t| + ((t isIndirectTempVector or: [t scope >= 0]) + ifTrue: [visibleTemps] + ifFalse: [invisibleTemps]) addLast: t]. + arguments := visibleTemps copyFrom: 1 to: nArgs. + temporaries := visibleTemps copyFrom: nArgs + 1 to: visibleTemps size. + block + arguments: arguments; + temporaries: temporaries. + properties := method properties copy. + (properties at: #onceCache ifAbsent: []) ifNotNil: + [:onceCache| + properties := properties copyWithout: (Association + key: #onceCache + value: onceCache)]. + blockNode := MethodNode new + selector: selectorNode + arguments: arguments + precedence: selector precedence + temporaries: temporaries + block: block + encoder: (method encoderClass new initScopeAndLiteralTables + temps: visibleTemps, invisibleTemps + literals: literalValues + class: class) + primitive: primitive + properties: properties. + blockNode properties method: blockNode. + ^blockNode! Item was added: + ----- Method: DecompilerConstructor>>codeRemoteTemp:remoteTemps: (in category 'as yet unclassified') ----- + codeRemoteTemp: index remoteTemps: tempVector + + ^(RemoteTempVectorNode new + name: '_r', index printString + index: index + type: LdTempType + scope: 0) + remoteTemps: tempVector; + yourself! Item was added: + ----- Method: DecompilerConstructor>>codeSelector:code: (in category 'constructor') ----- + codeSelector: sel code: code + + ^SelectorNode new key: sel code: code! Item was added: + ----- Method: DecompilerConstructor>>codeSuper (in category 'constructor') ----- + codeSuper + + ^NodeSuper! Item was added: + ----- Method: DecompilerConstructor>>codeTemp: (in category 'constructor') ----- + codeTemp: index + + ^ TempVariableNode new + name: 't' , (index + 1) printString + index: index + type: LdTempType + scope: 0! Item was added: + ----- Method: DecompilerConstructor>>codeTemp:named: (in category 'constructor') ----- + codeTemp: index named: tempName + + ^ TempVariableNode new + name: tempName + index: index + type: LdTempType + scope: 0! Item was added: + ----- Method: DecompilerConstructor>>codeThisContext (in category 'constructor') ----- + codeThisContext + + ^NodeThisContext! Item was added: + ----- Method: DecompilerConstructor>>decodeIfNilWithReceiver:selector:arguments:tempReadCounts: (in category 'constructor') ----- + decodeIfNilWithReceiver: receiver selector: selector arguments: arguments tempReadCounts: tempReadCounts + + | node temp | + receiver ifNil: [ ^nil ]. "For instance, when cascading" + selector == #ifTrue:ifFalse: + ifFalse: [^ nil]. + + (receiver isMessage: #== + receiver: nil + arguments: [:argNode | argNode == NodeNil]) + ifFalse: [^ nil]. + + "Like #to:(by:)do:, support only local temps." + (((temp := receiver ifNilTemporary) isNil or: [tempReadCounts includesKey: temp]) or: [ + "What about 'object ifNotNil: [:o | ]', which as not read the blockArg? Just check that there is no remote vector pointing to it." + tempReadCounts keys noneSatisfy: + [:otherTemp | + otherTemp isIndirectTempVector + ifTrue: [otherTemp remoteTemps anySatisfy: + [:remoteTemp | + remoteTemp name = temp name]] + ifFalse: [otherTemp name = temp name]] + ]) + ifFalse: [^ nil]. + + node := (MessageNode new + receiver: receiver + selector: (SelectorNode new key: #ifTrue:ifFalse: code: #macro) + arguments: arguments + precedence: 3). + + "Reconfigure the message node to #ifNil:ifNotNil:. Note that original* instance variables keep their optimized format. See MessageNode >> #printIfNilNotNil:indent:." + node + noteSpecialSelector: #ifNil:ifNotNil:; + selector: (SelectorNode new key: #ifNil:ifNotNil:). + + temp ifNil: [^ node]. + temp isTemp ifFalse: [^ node]. + + (arguments second isJust: NodeNil) not ifTrue: + [temp beBlockArg. + node arguments: { + arguments first. + arguments second copy arguments: { temp }; yourself }]. + + ^ node! Item was added: + ----- Method: DecompilerConstructor>>decodeLiteralVariableValueDereferenceWithReceiver:selector:arguments: (in category 'constructor') ----- + decodeLiteralVariableValueDereferenceWithReceiver: receiver selector: selector arguments: arguments + | varNode | + (receiver notNil "cascades" + and: [receiver isLiteralNode + and: [receiver key isVariableBinding]]) ifFalse: + [^nil]. + varNode := self codeAnyLitInd: receiver key. + selector = #value ifTrue: + [^varNode]. + ^selector = #value: ifTrue: + [self codeAssignTo: varNode value: arguments first]! Item was added: + ----- Method: DecompilerConstructor>>method:class:literals: (in category 'initialize-release') ----- + method: aMethod class: aClass literals: literals + + method := aMethod. + instVars := aClass allInstVarNames. + nArgs := method numArgs. + literalValues := literals! Item was added: + ----- Method: Dictionary>>bindingOf: (in category '*Compiler') ----- + bindingOf: varName + + ^self associationAt: varName ifAbsent: nil! Item was added: + ----- Method: Dictionary>>bindingOf:ifAbsent: (in category '*Compiler') ----- + bindingOf: varName ifAbsent: aBlock + + ^self associationAt: varName ifAbsent: aBlock! Item was added: + ----- Method: Dictionary>>bindingsDo: (in category '*Compiler') ----- + bindingsDo: aBlock + ^self associationsDo: aBlock! Item was added: + ParseNode subclass: #Encoder + instanceVariableNames: 'scopeTable nTemps supered requestor class selector literalStream selectorSet litIndSet litSet sourceRanges globalSourceRanges addedExtraLiterals optimizedSelectors cue' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !Encoder commentStamp: 'cwp 12/26/2012 23:29' prior: 0! + I encode names and literals into tree nodes with byte codes for the compiler. Byte codes for literals are not assigned until the tree-sizing pass of the compiler, because only then is it known which literals are actually needed. I also keep track of sourceCode ranges during parsing and code generation so I can provide an inverse map for the debugger.! Item was added: + ----- Method: Encoder>>accept: (in category 'visiting') ----- + accept: aVisitor + "I am not really a ParseNode. Only here to access constants defined in parseNode." + self shouldNotImplement! Item was added: + ----- Method: Encoder>>allLiterals (in category 'results') ----- + allLiterals + addedExtraLiterals ifFalse: + [addedExtraLiterals := true. + "Put the optimized selectors in literals so as to browse senders more easily" + optimizedSelectors := optimizedSelectors reject: [:e| literalStream originalContents hasLiteral: e]. + optimizedSelectors isEmpty ifFalse: [ + "Use one entry per literal if enough room, else make anArray" + literalStream position + optimizedSelectors size + 2 >= self maxNumLiterals + ifTrue: [self litIndex: optimizedSelectors asArray] + ifFalse: [optimizedSelectors do: [:e | self litIndex: e]]]. + "Add a slot for selector or MethodProperties" + self litIndex: nil. + self litIndex: self associationForClass]. + ^literalStream contents! Item was added: + ----- Method: Encoder>>associationForClass (in category 'results') ----- + associationForClass + | assoc | + assoc := self environment associationAt: cue getClass name ifAbsent: [nil]. + ^assoc value == cue getClass + ifTrue: [assoc] + ifFalse: [Association new value: cue getClass]! Item was added: + ----- Method: Encoder>>autoBind: (in category 'temps') ----- + autoBind: name + "Declare a block argument as a temp if not already declared." + | node | + node := scopeTable + at: name + ifAbsent: + [(self lookupInPools: name ifFound: [:assoc | assoc]) + ifTrue: [self warnAboutShadowed: name]. + ^ (self reallyBind: name) nowHasDef nowHasRef scope: 1]. + node isTemp + ifTrue: [node scope >= 0 ifTrue: + [^ self notify: 'Name already used in this method']. + node nowHasDef nowHasRef scope: 1] + ifFalse: [^ self notify: 'Name already used in this class']. + ^node! Item was added: + ----- Method: Encoder>>bindArg: (in category 'temps') ----- + bindArg: name + "Declare an argument." + | node | + nTemps >= 15 + ifTrue: [^self notify: 'Too many arguments']. + node := self bindTemp: name. + ^ node nowHasDef nowHasRef! Item was added: + ----- Method: Encoder>>bindBlockArg:within: (in category 'temps') ----- + bindBlockArg: name within: aBlockNode + "With standard Smalltalk-80 (BlueBook) blocks it used to be legal to use a + method temp as a block argument. This shouldn't be the case with the + current compiler, which checks for temp names already being used as + block arguments. But it is easily fooled by local block temps in optimized + blocks, e.g. + false + ifTrue: [| temp |] + ifFalse:[[:temp|]] + Rather than fix this we keep the semantics and fix it in the closure compiler." + ^self autoBind: name! Item was added: + ----- Method: Encoder>>bindBlockTemp: (in category 'temps') ----- + bindBlockTemp: name + "Declare a temporary block variable; complain if it's not a field or class variable." + + | node | + + node := scopeTable at: name ifAbsent: [^self reallyBind: name]. + node isTemp + ifTrue: [ + node scope >= 0 ifTrue: [^ self notify: 'Name already used in this method']. + node scope: 0] + ifFalse: [^self notify: 'Name already used in this class']. + ^node + ! Item was added: + ----- Method: Encoder>>bindBlockTemp:within: (in category 'temps') ----- + bindBlockTemp: name within: aBlockNode + "The BlockContext compiler (the Smalltalk-80 BlueBook compiler) + does provide support for ANSI block syntax, but not for ANSI block + semantics. Here all temps live at the same level, the method level. + The approach taken to two block-local temps in different blocks is to + merge them into a single temp. e.g. + expr + ifTrue: [|temp| self statementOne] + ifFalse: [|temp| self statementTwo] + is effectvely transformed into + | temp | + expr + ifTrue: [self statementOne] + ifFalse: [self statementTwo] + and + expr do: [:each| | temp | ...]. + expr do: [:each| | temp | ...]. + is also effectively transformed into + | temp | + expr do: [:each| ...]. + expr do: [:each| ...]. + + The closure compiler treats the former similarly, but not the latter. + The indirection through #bindBlockTemp:within: allows the closure encoder to do this." + ^self bindBlockTemp: name! Item was added: + ----- Method: Encoder>>bindTemp: (in category 'temps') ----- + bindTemp: name + "Declare a temporary; error not if a field or class variable." + scopeTable at: name ifPresent:[:node| + "When non-interactive raise the error only if its a duplicate" + node isTemp + ifTrue:[^self notify:'Name already used in this method'] + ifFalse:[self warnAboutShadowed: name]]. + ^self reallyBind: name! Item was added: + ----- Method: Encoder>>bindTemp:in: (in category 'temps') ----- + bindTemp: name in: methodSelector + "Declare a temporary; error not if a field or class variable." + scopeTable at: name ifPresent:[:node| + "When non-interactive raise the error only if its a duplicate" + (node isTemp or:[requestor interactive]) + ifTrue:[^self notify:'Name already used in this method'] + ifFalse:[Transcript + show: '(', name, ' is shadowed in "' , cue getClass printString , '>>' , methodSelector printString , '")']]. + ^self reallyBind: name! Item was added: + ----- Method: Encoder>>bindUndeclaredTemp: (in category 'private') ----- + bindUndeclaredTemp: name + ^scopeTable at: name put: (self newUndeclaredTemp: name)! Item was added: + ----- Method: Encoder>>cantStoreInto: (in category 'encoding') ----- + cantStoreInto: varName + + ^StdVariables includesKey: varName! Item was added: + ----- Method: Encoder>>classEncoding (in category 'private') ----- + classEncoding + "This is a hack so that the parser may findout what class it was parsing for when it wants to create a syntax error view." + ^ cue getClass! Item was added: + ----- Method: Encoder>>doItInContextName (in category 'encoding') ----- + doItInContextName + ^'ThisContext'! Item was added: + ----- Method: Encoder>>encodeLiteral: (in category 'encoding') ----- + encodeLiteral: object + ^self + name: object + key: object + class: LiteralNode + type: LdLitType + set: litSet! Item was added: + ----- Method: Encoder>>encodeSelector: (in category 'encoding') ----- + encodeSelector: aSelector + + ^self + name: aSelector + key: aSelector + class: SelectorNode + type: SendType + set: selectorSet! Item was added: + ----- Method: Encoder>>encodeVariable: (in category 'encoding') ----- + encodeVariable: name + ^ self encodeVariable: name sourceRange: nil ifUnknown: [ self undeclared: name ]! Item was added: + ----- Method: Encoder>>encodeVariable:ifUnknown: (in category 'encoding') ----- + encodeVariable: name ifUnknown: action + ^self encodeVariable: name sourceRange: nil ifUnknown: action! Item was added: + ----- Method: Encoder>>encodeVariable:sourceRange:ifUnknown: (in category 'encoding') ----- + encodeVariable: name sourceRange: range ifUnknown: action + | varNode | + varNode := scopeTable + at: name + ifAbsent: + [(self lookupInPools: name + ifFound: [:assoc | varNode := self global: assoc name: name]) + ifTrue: [varNode] + ifFalse: [^action value]]. + range ifNotNil: + [name first canBeGlobalVarInitial ifTrue: + [globalSourceRanges addLast: { name. range. false }]]. + + (varNode isTemp and: [varNode scope < 0]) ifTrue: + [^OutOfScopeNotification signal + ifTrue: [action value] + ifFalse: [self notify: 'out of scope']]. + ^varNode! Item was added: + ----- Method: Encoder>>environment (in category 'encoding') ----- + environment + "Answer the environment of the current compilation context, + be it in a class or global (e.g. a workspace)" + ^cue environment! Item was added: + ----- Method: Encoder>>fillDict:with:mapping:to: (in category 'initialize-release') ----- + fillDict: dict with: nodeClass mapping: keys to: codeArray + | codeStream | + codeStream := ReadStream on: codeArray. + keys do: + [:key | dict + at: key + put: (nodeClass new name: key key: key code: codeStream next)]! Item was added: + ----- Method: Encoder>>fixTemp: (in category 'temps') ----- + fixTemp: name + | node | + node := scopeTable at: name ifAbsent: []. + (node isTemp and: [node isIndirectTempVector not]) ifFalse: + [self error: 'can only fix a floating temp var']. + node index: nTemps. + nTemps := nTemps + 1. + ^node! Item was added: + ----- Method: Encoder>>floatTemp: (in category 'temps') ----- + floatTemp: node + (node == (scopeTable at: node name ifAbsent: []) + and: [node isTemp + and: [node index = (nTemps - 1)]]) ifFalse: + [self error: 'can only float the last allocated temp var']. + nTemps := nTemps - 1! Item was added: + ----- Method: Encoder>>global:name: (in category 'private') ----- + global: ref name: name + + ^self + name: name + key: ref + class: LiteralVariableNode + type: LdLitIndType + set: litIndSet! Item was added: + ----- Method: Encoder>>globalSourceRanges (in category 'source mapping') ----- + globalSourceRanges + + ^ globalSourceRanges! Item was added: + ----- Method: Encoder>>init:notifying: (in category 'initialize-release') ----- + init: aCue notifying: anObject + "The use of the variable requestor is a bit confusing here. This is + *not* the original requestor, which is available through the cue. + It's the Parser instance that is using the encoder." + + self setCue: aCue. + requestor := anObject. + nTemps := 0. + supered := false. + self initScopeAndLiteralTables. + cue getClass variablesAndOffsetsDo: + [:variable "<String|CFieldDefinition>" :offset "<Integer|nil>" | + offset isNil + ifTrue: [scopeTable at: variable name put: (FieldNode new fieldDefinition: variable)] + ifFalse: [scopeTable + at: variable + put: (offset >= 0 + ifTrue: [InstanceVariableNode new + name: variable index: offset] + ifFalse: [MaybeContextInstanceVariableNode new + name: variable index: offset negated])]]. + cue context ifNotNil: + [| homeNode | + homeNode := self bindArg: self doItInContextName. + "0th temp = aContext passed as arg" + cue context tempNames withIndexDo: + [:variable :index| + variable ~= self doItInContextName ifTrue: + [scopeTable + at: variable + put: (MessageAsTempNode new + receiver: homeNode + selector: #namedTempAt: + arguments: (Array with: (self encodeLiteral: index)) + precedence: 3 + from: self)]]]. + sourceRanges := Dictionary new: 32. + globalSourceRanges := OrderedCollection new: 32! Item was added: + ----- Method: Encoder>>initScopeAndLiteralTables (in category 'initialize-release') ----- + initScopeAndLiteralTables + + scopeTable := StdVariables copy. + litSet := StdLiterals copy. + "comments can be left hanging on nodes from previous compilations. + probably better than this hack fix is to create the nodes afresh on each compilation." + scopeTable do: + [:varNode| varNode comment: nil]. + litSet do: + [:varNode| varNode comment: nil]. + selectorSet := StdSelectors copy. + litIndSet := Dictionary new: 16. + literalStream := WriteStream on: (Array new: 32). + addedExtraLiterals := false. + optimizedSelectors := Set new! Item was added: + ----- Method: Encoder>>interactive (in category 'private') ----- + interactive + "Answer true if compilation is interactive" + + ^requestor interactive! Item was added: + ----- Method: Encoder>>litIndex: (in category 'encoding') ----- + litIndex: literal + | p | + p := literalStream position. + p = self maxNumLiterals ifTrue: + [self notify: 'More than ', self maxNumLiterals printString, ' literals referenced.\You must split or otherwise simplify this method.\The ' withCRs, (self maxNumLiterals + 1) printString, 'th literal is: ', literal printString. ^nil]. + literal isLiteral ifTrue: "filters out BlockClosures, ExternalLibraryFunctions" + [self setReadOnlyIfAppropriate: literal]. + "Would like to show where it is in the source code, but that info is hard to get." + literalStream nextPut: literal. + ^p! Item was added: + ----- Method: Encoder>>literals (in category 'results') ----- + literals + "Should only be used for decompiling primitives" + ^ literalStream contents! Item was added: + ----- Method: Encoder>>lookupInPools:ifFound: (in category 'private') ----- + lookupInPools: varName ifFound: assocBlock + + ^(Symbol lookup: varName) + ifNil: [ false ] + ifNotNil: [ :symbol | + (cue bindingOf: symbol) + ifNil: [ false ] + ifNotNil: [:assoc| + assocBlock value: assoc. + true ]]! Item was added: + ----- Method: Encoder>>lookupVariable:ifAbsent: (in category 'encoding') ----- + lookupVariable: name ifAbsent: aBlock + "Answer the binding of name in the scope table or aBlock's vaue if none. + Do not bind and do not lookup in pools. Used for correction, explanation etc" + ^scopeTable at: name ifAbsent: aBlock! Item was added: + ----- Method: Encoder>>maxIndexableLiterals (in category 'accessing') ----- + maxIndexableLiterals + "Answer the maximum number of literals supported by the receiver's + bytecode set. This is a nominal value based on the Blue Book bytecode + set; subclasses answer a more accurate value." + ^63! Item was added: + ----- Method: Encoder>>maxNumLiterals (in category 'accessing') ----- + maxNumLiterals + ^CompiledMethod maxNumLiterals min: self maxIndexableLiterals! Item was added: + ----- Method: Encoder>>maxTemp (in category 'temps') ----- + maxTemp + + ^nTemps! Item was added: + ----- Method: Encoder>>methodNodeClass (in category 'accessing') ----- + methodNodeClass + ^MethodNode! Item was added: + ----- Method: Encoder>>name:key:class:type:set: (in category 'private') ----- + name: name key: key class: leafNodeClass type: type set: dict + ^dict at: key + ifAbsentPut: + [leafNodeClass new + name: name + key: key + index: nil + type: type]! Item was added: + ----- Method: Encoder>>newTemp: (in category 'temps') ----- + newTemp: name + + nTemps := nTemps + 1. + ^ TempVariableNode new + name: name + index: nTemps - 1 + type: LdTempType + scope: 0! Item was added: + ----- Method: Encoder>>newUndeclaredTemp: (in category 'temps') ----- + newUndeclaredTemp: name + ^UndeclaredVariableNode new name: name! Item was added: + ----- Method: Encoder>>noteOptimizedSelector: (in category 'encoding') ----- + noteOptimizedSelector: aSymbol + "Register a selector as being optimized. + These optimized selectors will later be registered into the literals so that tools can easily browse senders." + optimizedSelectors add: aSymbol! Item was added: + ----- Method: Encoder>>noteSourceRange:forNode: (in category 'source mapping') ----- + noteSourceRange: range forNode: node + + sourceRanges at: node put: range! Item was added: + ----- Method: Encoder>>noteSuper (in category 'initialize-release') ----- + noteSuper + + supered := true! Item was added: + ----- Method: Encoder>>notify: (in category 'error handling') ----- + notify: string + "Put a separate notifier on top of the requestor's window" + | req | + requestor == nil + ifFalse: + [req := requestor. + self release. + req notify: string]. + ^false! Item was added: + ----- Method: Encoder>>notify:at: (in category 'error handling') ----- + notify: string at: location + + | req | + requestor == nil + ifFalse: + [req := requestor. + self release. + req notify: string at: location]. + ^false! Item was added: + ----- Method: Encoder>>possibleNamesFor: (in category 'private') ----- + possibleNamesFor: proposedName + | results | + results := cue getClass + possibleVariablesFor: proposedName + continuedFrom: nil. + ^ proposedName correctAgainst: nil continuedFrom: results. + ! Item was added: + ----- Method: Encoder>>possibleVariablesFor: (in category 'private') ----- + possibleVariablesFor: proposedVariable + + | results | + results := proposedVariable correctAgainstDictionary: scopeTable + continuedFrom: nil. + proposedVariable first canBeGlobalVarInitial ifTrue: + [ results := cue getClass possibleVariablesFor: proposedVariable + continuedFrom: results ]. + ^ proposedVariable correctAgainst: nil continuedFrom: results. + ! Item was added: + ----- Method: Encoder>>rawSourceRanges (in category 'source mapping') ----- + rawSourceRanges + + ^ sourceRanges ! Item was added: + ----- Method: Encoder>>reallyBind: (in category 'private') ----- + reallyBind: name + + | node | + node := self newTemp: name. + scopeTable at: name put: node. + ^node! Item was added: + ----- Method: Encoder>>release (in category 'initialize-release') ----- + release + + requestor := nil! Item was added: + ----- Method: Encoder>>selector (in category 'accessing') ----- + selector + ^selector! Item was added: + ----- Method: Encoder>>selector: (in category 'accessing') ----- + selector: aSymbol + selector := aSymbol! Item was added: + ----- Method: Encoder>>setCue: (in category 'private') ----- + setCue: aCue + cue := aCue. + + "Also set legacy instance variables for methods that + don't use cue yet" + class := cue getClass.! Item was added: + ----- Method: Encoder>>setReadOnlyIfAppropriate: (in category 'encoding') ----- + setReadOnlyIfAppropriate: literal + "If literal is not read-only and should be, set it to be read-only, along with any other such literals it may contain." + (literal isReadOnlyObject + or: [literal isVariableBinding]) ifFalse: + [literal setIsReadOnlyObject: true. + literal isArray ifTrue: + [literal do: [:subLiteral| self setReadOnlyIfAppropriate: subLiteral]]]! Item was added: + ----- Method: Encoder>>sharableLitIndex: (in category 'encoding') ----- + sharableLitIndex: literal + "Special access prevents multiple entries for post-allocated super send special selectors" + 1 to: literalStream position do: + [:index| + (literal literalEqual: (literalStream originalContents at: index)) ifTrue: + [^index - 1]]. + ^self litIndex: literal! Item was added: + ----- Method: Encoder>>sourceMap (in category 'source mapping') ----- + sourceMap + "Answer with a sorted set of associations (pc range)." + + ^sourceRanges associations + replace: [ :association | Association key: association key pc value: association value ]; + sort! Item was added: + ----- Method: Encoder>>sourceRangeFor: (in category 'source mapping') ----- + sourceRangeFor: node + + ^sourceRanges at: node! Item was added: + ----- Method: Encoder>>tempNames (in category 'results') ----- + tempNames + + ^ self tempNodes collect: + [:node | (node isMemberOf: MessageAsTempNode) + ifTrue: [scopeTable keyAtValue: node] + ifFalse: [node key]]! Item was added: + ----- Method: Encoder>>tempNodes (in category 'results') ----- + tempNodes + + | tempNodes | + tempNodes := OrderedCollection new. + scopeTable associationsDo: + [:assn | + assn value isArray + ifTrue: [assn value do: [:temp| tempNodes add: temp]] + ifFalse: [assn value isTemp ifTrue: [tempNodes add: assn value]]]. + ^tempNodes sort: [:n1 :n2 | n1 index <= n2 index]! Item was added: + ----- Method: Encoder>>temps:literals:class: (in category 'initialize-release') ----- + temps: tempVars literals: lits class: cl + "Initialize this encoder for decompilation." + + self setCue: (CompilationCue class: cl). + supered := false. + nTemps := tempVars size. + tempVars do: [:node | scopeTable at: node name put: node]. + literalStream := WriteStream on: (Array new: lits size). + literalStream nextPutAll: lits. + sourceRanges := Dictionary new: 32. + globalSourceRanges := OrderedCollection new: 32.! Item was added: + ----- Method: Encoder>>tempsAndBlockArgs (in category 'results') ----- + tempsAndBlockArgs + | tempNodes | + tempNodes := OrderedCollection new. + scopeTable associationsDo: + [:assn | | var | + var := assn value. + (var isTemp + and: [var isMethodArg not + and: [var scope = 0 or: [var scope = -1]]]) ifTrue: + [tempNodes add: var]]. + ^tempNodes! Item was added: + ----- Method: Encoder>>undeclared: (in category 'encoding') ----- + undeclared: name + | sym | + (requestor notNil and: [requestor interactive]) ifTrue: + [ requestor requestor == #error: ifTrue: [ requestor error: 'Undeclared' ]. + ^ self notify: 'Undeclared' ]. + "Allow knowlegeable clients to squash the undeclared warning if they want (e.g. + Diffing pretty printers that are simply formatting text). As this breaks + compilation it should only be used by clients that want to discard the result + of the compilation. To squash the warning use e.g. + [Compiler format: code in: class notifying: nil decorated: false] + on: UndeclaredVariableNotification + do: [:ex| ex resume: false]" + sym := name asSymbol. + ^ (UndeclaredVariableNotification new + name: name + selector: selector + class: cue getClass) signal + ifTrue: + [ | undeclared assoc | + undeclared := cue environment undeclared. + assoc := [ undeclared add: (undeclared associationClass key: sym value: nil) ] + on: AttemptToWriteReadOnlyGlobal + do: [ : noti | noti resume: true ]. + self + global: assoc + name: sym ] + ifFalse: + [ self + global: (Association key: sym) + name: sym ]! Item was added: + ----- Method: Encoder>>undeclaredTemps (in category 'results') ----- + undeclaredTemps + ^(scopeTable select: [:var | var isVariableNode and: [var isUndeclared]]) values! Item was added: + ----- Method: Encoder>>unusedTempNames (in category 'results') ----- + unusedTempNames + | unused | + unused := OrderedCollection new. + scopeTable associationsDo: + [:assn | | name | + (assn value isUnusedTemp) ifTrue: + [name := assn value key. + name ~= self doItInContextName ifTrue: [unused add: name]]]. + ^ unused! Item was added: + ----- Method: Encoder>>warnAboutShadowed: (in category 'private') ----- + warnAboutShadowed: name + + requestor addWarning: name,' is shadowed'. + selector ifNil: [^ self]. + (ShadowedVariableNotification new + name: name + selector: selector + class: cue getClass) signal.! Item was added: + BytecodeEncoder subclass: #EncoderForSistaV1 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !EncoderForSistaV1 commentStamp: 'eem 3/10/2022 10:59' prior: 0! + EncoderForSistaV1 encodes a bytecode set for Smalltalk that lifts limits on the number of literals, branch distances, the number of temporary variables, and provides extended push integer and push character bytecodes. The bytecode set also supports creating FullBlockClosures, closures whose method is separate from their home method's. Bytecodes are ordered by length to make decoding easier. Bytecodes marked with an * are extensible via a prefix extension bytecode. + + N.B. Extension bytecodes can only come before extensible bytecodes, and only if valid (one cannot extend a bytecode extensible by Ext A with an Ext B). An extensible bytecode consumes (and zeros) its extension(s). Hence the hidden implicit variables holding extensions are always zero except after a valid sequence of extension bytecodes. The implication is that a bytecode interpreter should maintain the extension values in static variables initialized to zero at start-up, and live only from the start of a sequence of extension bytecodes to the end of the extended bytecode immediately following. + + While the bytecode set lifts limits, it still assumes there are no more than 65535 literals (as of 2020 the CompiledCode header word imposes a 32,767 limit on number of literals), and no more than 256 stack slots (used for arguments, temporaries, and stack contents) in a Context. + + EncoderForSistaV1 also includes an extended set of bytecodes for Sista, the Speculative Inlining Smalltalk Architecture, a project by Clément Bera and Eliot Miranda. Scorch is an optimizer that exists in the Smalltalk image, /not/ in the VM, and optimizes by substituting normal bytecoded methods by optimized bytecoded methods that may use special bytecodes for which the Cogit can generate faster code. These bytecodes eliminate overheads such as bounds checks or polymorphic code (indexing Array, ByteArray, String etc). But the bulk of the optimization performed is in inlining blocks and sends for the common path. This bytecode set therefore differs from a normal Smalltalk set in providing a set of inlined primitives that do not validate their arguments that the compiler generates only when it can prove that the primitives' arguments are valid. + + The basic scheme is that the Cogit generates code containing performance counters. When these counters trip, a callback into the image is performed, at which point Scorch analyses some portion of the stack, looking at performance data for the methods on the stack, and optimises based on the stack and performance data. Execution then resumes in the optimized code. + + The Sista Cogit (e.g. SistaStackToRegisterMappingCogit) adds counters to conditional branches. Each branch has an executed and a taken count. On execution the executed count is decremented and if the count goes below zero the VM sends a message at a special index in the specialObjectsArray (as of writing, conditionalCounterTrippedOn:). Then if the branch is taken the taken count is decremented. The two counter values allow the Sista optimizer to collect basic block execution paths and to know what are the "hot" paths through execution that are worth agressively optimizing. Since conditional branches are about 1/6 as frequent as sends, and since they can be used to determine the hot path through code, they are a better choice to count than, for example, method or block entry. + + The VM provides a primitive that fills an Array with the state of the counters, and the state of each linked send in a method. The optimizer obtains the branch and send data for a method via this primitive. + + Instance Variables (inherited) + + Here is the list of bytecodes. An asterisk implies the bytecode takes either extA or extB extensions. Two asterisks imply it takes both extA and extB extensions. A number in parentheses is a note. See the notes at the end of the table. + + 1 Byte Bytecodes + code (note) binary name + 0-15 0000 iiii Push Receiver Variable #iiii + 16-31 0001 iiii Push Literal Variable #iiii + 32-63 001 iiiii Push Literal #iiiii + 64-71 01000 iii Push Temp #iii + 72-75 010010 ii Push Temp #ii + 8 + 76 01001100 Push Receiver + 77 01001101 Push true + 78 01001110 Push false + 79 01001111 Push nil + 80 01010000 Push 0 + 81 01010001 Push 1 + * 82 01010010 Push thisContext, (then Extend B = 1 => push thisProcess) + 83 01010011 Duplicate Stack Top + 84-87 010101 ii UNASSIGNED + 88-91 010110 ii Return Receiver/true/false/nil + 92 01011100 Return top + 93 01011101 BlockReturn nil + * 94 01011110 BlockReturn Top [* return from enclosing block N, N = Extend A, then jump by Ext B ] + * 95 01011111 Nop + 96-111 0110 iiii Send Arithmetic Message #iiii (+ - < > <= >= = ~= * / \\ @ bitShift: // bitAnd: bitOr:) + 112-119 01110 iii Send Special Message #iii + 0 (at: at:put: size next nextPut: atEnd == class) + 120-127 01111 iii Send Special Message #iii + 8 (~~ value value: do: new new: x y) + 128-143 1000 iiii Send Literal Selector #iiii With 0 Argument + 144-159 1001 iiii Send Literal Selector #iiii With 1 Arguments + 160-175 1010 iiii Send Literal Selector #iiii With 2 Arguments + 176-183 10110 iii Jump iii + 1 (i.e., 1 through 8) + 184-191 10111 iii Pop and Jump 0n True iii +1 (i.e., 1 through 8) + 192-199 11000 iii Pop and Jump 0n False iii +1 (i.e., 1 through 8) + 200-207 11001 iii Pop and Store Receiver Variable #iii + 208-215 11010 iii Pop and Store Temporary Variable #iii + 216 11011000 Pop Stack Top + 217 (5) 11011001 Unconditional trap + 218-219 1101101 i UNASSIGNED + 220-223 110111 ii UNASSIGNED + + 2 Byte Bytecodes + * 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) A is an unsigned extension. + * 225 11100001 bbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B) B is a signed extension. + * 226 11100010 iiiiiiii Push Receiver Variable #iiiiiiii (+ Extend A * 256) + * 227 11100011 iiiiiiii Push Literal Variable #iiiiiiii (+ Extend A * 256) + * 228 11100100 iiiiiiii Push Literal #iiiiiiii (+ Extend A * 256) + 229 11100101 iiiiiiii Push Temporary Variable #iiiiiiii + 230 11100110 iiiiiiii UNASSIGNED (was pushNClosureTemps) + 231 11100111 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) + & Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1) + * 232 11101000 iiiiiiii Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, d=0, s=1) + * 233 11101001 iiiiiiii Push Character #iiiiiiii (+ Extend A * 256) + ** 234 11101010 iiiiijjj Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments + ** 235 (1) 11101011 iiiiijjj ExtendB < 64 + ifTrue: [Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments] + ifFalse: [Send To Superclass of Stacked Class Literal Selector #iiiii (+ Extend A * 32) with jjj (+ (Extend B bitAnd: 63) * 8) Arguments] + 236 11101100 iiiiiiii UNASSIGNED + * 237 11101101 iiiiiiii Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, d=0, s=1) + ** 238 (4) 11101110 iiiiiiii Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0) + ** 239 (4) 11101111 iiiiiiii Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0) + ** 240 (3) 11110000 iiiiiiii Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256) + ** 241 (3) 11110001 iiiiiiii Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256) + 242 11110010 iiiiiiii Pop and Store Temporary Variable #iiiiiiii + ** 243 (3) 11110011 iiiiiiii Store Receiver Variable #iiiiiii (+ Extend A * 256) + ** 244 (3) 11110100 iiiiiiii Store Literal Variable #iiiiiiii (+ Extend A * 256) + 245 11110110 iiiiiiii Store Temporary Variable #iiiiiiii + 246-247 1111011 i xxxxxxxx UNASSIGNED + + 3 Byte Bytecodes + 248 (2) 11111000 iiiiiiii mssjjjjj Call Primitive #iiiiiiii + (jjjjj * 256) + m=1 means inlined primitive, no hard return after execution. + ss defines the unsafe operation set used to encode the operations. + (ss = 0 means sista unsafe operations, ss = 01 means lowcode operations, other numbers are as yet used) + Lowcode inlined primitives may have extensions. + * 249 11111001 xxxxxxxx siyyyyyy Push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1 + ** 250 11111010 eeiiikkk jjjjjjjj Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions + 251 11111011 kkkkkkkk sjjjjjjj Push Temp At kkkkkkkk In Temp Vector At: jjjjjjj, s = 1 implies remote inst var access instead of remote temp vector access + * 252 (3) 11111100 kkkkkkkk sjjjjjjj Store Temp At kkkkkkkk In Temp Vector At: jjjjjjj s = 1 implies remote inst var access instead of remote temp vector access + * 253 (3) 11111101 kkkkkkkk sjjjjjjj Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjj s = 1 implies remote inst var access instead of remote temp vector access + ** 254 (5) 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior literal kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0 and <= 127) + ** 254 (5) 11111110 kkkkkkkk jjjjjjjj branch If Instance Of Behavior/Array Of Behavior literal kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ (Extend B bitAnd: 127) * 256, where Extend B >= 128 and <= 255) + * 255 11111111 xxxxxxxx jjjjjjjj UNASSIGNED + + (1) Bytecode 235 is a super send bytecode that starts the lookup in the superclass of some class. It has two forms, "normal" and "directed". In the normal form, the class is the value of the method's methodClassAssociation which must be the last literal. In the directed form the class is the class on top of stack. + + (2) The Call Primitive Bytecode (see below) specifies either a primitive in the primitive table (m=0) or an inlined primitive (m=1). Non-inlined primitives from the primitive table have index (jjjjjjj * 256) + iiiiiiii and return from the method if they succeed. This bytecode is only valid as the first bytecode of a method. Inline primitives have index (jjjjjjj * 256) + iiiiiiii, cannot fail, and do not return when they succeed, yielding a result (typically on top of stack after popping their arguments, but possibly in a byte data stack, for example for unboxed floating-point primitives). + + (3) ExtB lowest bit implies no store check is needed, ExtB second bit implies the object may be a context, ExtB third bit implies no immutability/read-only check is needed, other bits in the extension are unused. + + (4) ExtA = 1 implies no mustBeBoolean trampoline is needed, other bits in the extension are unused + + (5) these are Scorch/Sista bytecodes generated by an optimizing compiler and not used in normal Smalltalk code. + + + The CallPrimitive bytecode is divided into two halves, those for normal primtiives, occurring at the beginning of a method, and those for inline primitives, anywhere within the body of a method. This is a three byte bytecode, the first byte being 248, and the second byte being a big-endian 16-bit primitive index. If the top bit of the first byte of the primitive index is 1 then this is a normal primitive invocation. If it is zero then the remaining 15 bits define 32k primitives, organized as four 8k "pages". The first page is used for and reserved by the Sista optimizing compiler. The second page is usd for and reserved by the Lowcode FFI marshalling primitive set. The other two sets are unspecified and unused. + + Here is the specification of the Sista unsafe instructions (unsafe operations, set 00). The lowcode set uses external specifications. + We sort the inline primitive operations by arity. Nullary primitives occupy the 0-999 range. Unary primitives occupy the 1-1999 range, up until 8 args. 8191 instructions can be encoded in each unsafe operation set, instructions from 0 to 7 arguments can have 1000 different instructions each, while 8 args instructions can have 192 different instructions. + + Sista defines the following inlined primitives (CallPrimitive iiiiiiii 100jjjjj, n = jjjjjiiiiiiii) + 1000 class + 1001 pointer numSlots + 1002 pointer basicSize + 1003 byte8Type format numBytes (includes CompiledMethod) + 1004 short16Type format numShorts + 1005 word32Type format numWords + 1006 doubleWord64Type format numDoubleWords + + 1010 ensure number of bytes available. + 1011 fixed-sized new. (objects with 0 to n inst vars) + + 1020 identityHash (non-immediate, non-Behavior) + 1021 identityHash (SmallInteger) + 1022 identityHash (Character) + 1023 identityHash (SmallFloat64) + 1024 identityHash (Behavior, has hash?) + + 1030 immediateAsInteger (Character) + 1031 immediateAsInteger (SmallFloat64) + 1035 immediateAsFloat (Smallinteger) + + 2000 SmallInteger #+. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2001 SmallInteger #-. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2002 SmallInteger #*. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2003 SmallInteger #/. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2004 SmallInteger #//. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2005 SmallInteger #\\. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2006 SmallInteger #quo:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + + 2011 Variable-sized pointers new (new:). Array, etc. + 2012 Variable-sized byte new (new:). ByteArray, ByteString, etc. + 2013 Variable-sized 16-bit new (new:). DoubleByteArray, etc. + 2014 Variable-sized 32-bit new (new:). Bitmap, FloatArray, etc. + 2015 Variable-sized 64-bit new (new:). DoubleWordArray, etc. + + 2016 SmallInteger #bitAnd:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2017 SmallInteger #bitOr:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2018 SmallInteger #bitXor:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2019 SmallInteger #bitShiftLeft:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + 2020 SmallInteger #bitShiftRight:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size) + + 2032 SmallInteger #>. Both arguments are SmallIntegers + 2033 SmallInteger #<. Both arguments are SmallIntegers + 2034 SmallInteger #>=. Both arguments are SmallIntegers + 2035 SmallInteger #<=. Both arguments are SmallIntegers + 2036 SmallInteger #=. Both arguments are SmallIntegers + 2037 SmallInteger #~=. Both arguments are SmallIntegers + + 2064 Pointer Object>>at:. The receiver is guaranteed to be a pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger + 2065 Byte Object>>at:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The result is a SmallInteger. + 2066 16-bit Word Object>>at:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The result is a SmallInteger. + 2067 32-bit DoubleWord Object>>at:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The result is a SmallInteger or a LargePositiveInteger. + 2068 64-bit QuadWord Object>>at:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The result is a SmallInteger or a LargePositiveInteger. + + The following instructions can have the ExtB check flag (See (3)). + 3000 Pointer Object>>at:put:. The receiver is guaranteed to be a pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger + 3001 Byte Object>>at:put:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The argument is a SmallInteger. The primitive stores the least significant 8 bits. + 3002 Word Object>>at:put:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The argument is a SmallInteger. The primitive stores the least significant 16 bits. + 3003 DoubleWord Object>>at:put:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The argument is a SmallInteger. The primitive stores the least significant 32 bits. + 3004 QuadWord Object>>at:put:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The argument is a SmallInteger. The primitive stores the least significant 64 bits. + + 3021 Byte Object >> equals:length: The receiver and the arguments are both byte objects and have both the same size (length). The length argument is a smallinteger. Answers true if all fields are equal, false if not. Comparison is bulked to word comparison. + + 4000 Pointer Object>> fillFrom:to:with: The receiver is a Pointer object. the middle two arguments are smallintegers. Last argument is any object. Fills the object in between the two indexes with last argument. Receiver is guaranteed to be mutable. The pointer accesses are raw (no inst var check). If ExtB is set to 1, no store check is present. Else a single store check is done for the bulk operation. Answers the receiver. + + 5000 Pointer Object>> replaceFrom:to:with:startingAt: Src and dest are pointer objects. ScrPos, scrLast and destLast are smallintegers. Receiver is guaranteed to be mutable. Both ranges are in-bounds. The pointer accesses are raw (no inst var check). As for the normal primitive, the copy is linear. Answers the receiver. + + + Lowcode defines inlined primitives for the range CallPrimitive iiiiiiii 101jjjjj, n = jjjjjiiiiiiii.! Item was added: + ----- Method: EncoderForSistaV1 class>>bindingReadScanBlockFor:using: (in category 'compiled method support') ----- + bindingReadScanBlockFor: litVarIndex using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for reads of the value of the binding with zero-relative index litVarIndex. + N.B. Don't assume the compiler uses the most compact encoding available." + + " 16-31 0001 i i i i Push Literal Variable #iiii + * 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 227 11100011 i i i i i i i i Push Literal Variable #iiiiiiii (+ Extend A * 256)" + | extension | + extension := 0. + ^[:b| | prevext | + prevext := extension. + extension := b = 224 ifTrue: [scanner followingByte bitShift: 8] ifFalse: [0]. + (b < 32 and: [b >= 16 and: [b - 16 = litVarIndex]]) + or: [b = 227 + and: [scanner followingByte + prevext = litVarIndex]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>bindingWriteScanBlockFor:using: (in category 'compiled method support') ----- + bindingWriteScanBlockFor: litVarIndex using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for writes of the value of the binding with zero-relative index litVarIndex. + N.B. Don't assume the compiler uses the most compact encoding available." + + "* 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 241 11110001 iiiiiiii Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256) + * 244 11110100 iiiiiiii Store Literal Variable #iiiiiiii (+ Extend A * 256)" + | extension | + extension := 0. + ^[:b| | prevext | + prevext := extension. + extension := b = 224 ifTrue: [scanner followingByte bitShift: 8] ifFalse: [0]. + (b = 241 or: [b = 244]) + and: [scanner followingByte + prevext = litVarIndex]]! Item was added: + ----- Method: EncoderForSistaV1 class>>blockMethodOrNilFor:in:at: (in category 'instruction stream support') ----- + blockMethodOrNilFor: anInstructionStream in: method at: pc + "If anInstructionStream is at a block creation bytecode then answer the block's + CompiledBlock, otherwise answer nil. + + The complication is that for convenience we allow the pc to point to the + raw send bytecode after its extension(s), or at the extension(s) preceding it. + 249 11111001 xxxxxxxx siyyyyyy push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1" + + | byte | + byte := method at: pc. + byte = 249 ifTrue: + ["it could be extended..." + ^self extensionsFor: pc in: method into: + [:extA :extB :nExtBytes| + method literalAt: (method at: pc + nExtBytes + 1) + (extA bitShift: 8) + 1]]. + ^byte = 16rE0 ifTrue: + [self extensionsAt: pc in: method into: + [:extA :extB :nExtBytes| + (method at: pc + nExtBytes) = 249 ifTrue: + [method literalAt: (method at: pc + nExtBytes + 1) + (extA bitShift: 8) + 1]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>bytecodeSize: (in category 'instruction stream support') ----- + bytecodeSize: bytecode + "Answer the number of bytes in the bytecode." + bytecode < 224 ifTrue: [^1]. + bytecode < 248 ifTrue: [^2]. + ^3! Item was added: + ----- Method: EncoderForSistaV1 class>>callPrimitiveCode (in category 'bytecode decoding') ----- + callPrimitiveCode + "Answer the call primitive bytecode, if it exists in the encoder's bytecode set, or nil if not. + 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution." + ^248! Item was added: + ----- Method: EncoderForSistaV1 class>>canBeSpecialLiteral: (in category 'testing') ----- + canBeSpecialLiteral: aLiteral + "This check can be used to prevent unnecessary use of #scanBlockOrNilForLiteral:." + + aLiteral isVariableBinding ifTrue: [^false]. "a common case; don't waste time analysing..." + + aLiteral isSymbol ifTrue: [^ Smalltalk specialSelectors identityIncludes: aLiteral]. + aLiteral isCharacter ifTrue: [^ aLiteral asInteger <= 65535]. + aLiteral isInteger ifTrue: [^ aLiteral between: -32768 and: 32767]. + + aLiteral == true ifTrue: [^ true]. + aLiteral == false ifTrue: [^ true]. + aLiteral == nil ifTrue: [^ true]. + + ^ false! Item was added: + ----- Method: EncoderForSistaV1 class>>createClosureCode (in category 'bytecode decoding') ----- + createClosureCode + "Answer the create closure bytecode, if it exists in the encoder's bytecode set, or nil if not. + Actually this code is that for a closure whose bytecodes are nested within its home method's." + + ^250! Item was added: + ----- Method: EncoderForSistaV1 class>>createClosureScanBlock (in category 'compiled method support') ----- + createClosureScanBlock + "Answer a block argument for InstructionStream>>scanFor: that answers true + for block closure creation bytecodes. Note that with this interface we can't answer + true for the extension in front of a push closure bytecode and so the interface may + have to change at some point." + + "* 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 225 11100001 bbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B) + ** 249 11111001 xxxxxxxx siyyyyyy push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1 + ** 250 11111010 eeiiikkk jjjjjjjj Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions" + ^[:b| b >= 249 and: [b <= 250]]! Item was added: + ----- Method: EncoderForSistaV1 class>>extensionsAt:in:into: (in category 'compiled method support') ----- + extensionsAt: bcpc in: method into: aTrinaryBlock + "If the bytecode at pc is an extension then evaluate aBinaryBlock with the values of extA and extB and number of extension *bytes*. + If the bytecode at pc is not extended then evaluate aBinaryBlock with 0 and 0. + 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + 225 11100001 bbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B)" + + | scanpc byte extByte extA extB | + scanpc := bcpc. + "There may be an extension (it could be a false positive). We must scan as fast as possible..." + extA := extB := 0. + [byte := method at: scanpc. + byte >= 224 and: [byte <= 225]] whileTrue: + [extByte := method at: scanpc + 1. + scanpc := scanpc + 2. + byte = 224 + ifTrue: + [extA := (extA bitShift: 8) + extByte] + ifFalse: + [extB := (extB = 0 and: [extByte > 127]) + ifTrue: [extByte - 256] + ifFalse: [(extB bitShift: 8) + extByte]]]. + ^aTrinaryBlock value: extA value: extB value: scanpc - bcpc + + + "Why use + byte >= 224 and: [byte <= 225] + and not + (byte bitAnd: 16rFE) = 16rE0 + ? + | n | + n := 100000000. + #(0 224) collect: + [:byte| + { Time millisecondsToRun: [1 to: n do: [:i| (byte >= 224 and: [byte <= 225]) ifTrue: []]]. + Time millisecondsToRun: [1 to: n do: [:i| (byte bitAnd: 16rFE) = 16rE0 ifTrue: []]] }] #(#(297 599) #(702 671))"! Item was added: + ----- Method: EncoderForSistaV1 class>>instVarReadScanBlockFor:using: (in category 'compiled method support') ----- + instVarReadScanBlockFor: varIndexCode using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for reads of the inst var with zero-relative index varIndexCode. + N.B. Don't assume the compiler uses the most compact encoding available." + + " 0-15 0000 i i i i Push Receiver Variable #iiii + * 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 226 11100010 i i i i i i i i Push Receiver Variable #iiiiiiii (+ Extend A * 256)" + | extension | + extension := 0. + ^[:b| | prevext | + prevext := extension. + extension := b = 224 ifTrue: [scanner followingByte bitShift: 8] ifFalse: [0]. + (b < 16 and: [b = varIndexCode]) + or: [b = 226 + and: [scanner followingByte + prevext = varIndexCode]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>instVarWriteScanBlockFor:using: (in category 'compiled method support') ----- + instVarWriteScanBlockFor: varIndexCode using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for writes of the inst var with zero-relative index varIndexCode. + N.B. Don't assume the compiler uses the most compact encoding available." + + " 200-207 11001 iii Pop and Store Receiver Variable #iii + * 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 240 11110000 iiiiiiii Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256) + * 243 11110011 iiiiiiii Store Receiver Variable #iiiiiii (+ Extend A * 256)" + | extension | + extension := 0. + ^[:b| | prevext | + prevext := extension. + extension := b = 224 ifTrue: [scanner followingByte bitShift: 8] ifFalse: [0]. + (b >= 200 + and: [b < 208 + and: [b - 200 = varIndexCode]]) + or: [(b = 240 or: [b = 243]) + and: [scanner followingByte + prevext = varIndexCode]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>interpretJumpIfCondIn: (in category 'compiled method support') ----- + interpretJumpIfCondIn: anInstructionStream + "Double-dispatch through the encoder to select the correct conditional jump decoder for the instruction set." + ^anInstructionStream interpretSistaV1JumpIfCond! Item was added: + ----- Method: EncoderForSistaV1 class>>interpretJumpIn: (in category 'compiled method support') ----- + interpretJumpIn: anInstructionStream + "Double-dispatch through the encoder to select the correct unconditional jump decoder for the instruction set." + ^anInstructionStream interpretSistaV1Jump! Item was added: + ----- Method: EncoderForSistaV1 class>>interpretNextInstructionFor:in: (in category 'instruction stream support') ----- + interpretNextInstructionFor: aClient in: anInstructionStream + "Double-dispatch through the encoder to select the correct instruction set decoder." + ^anInstructionStream interpretNextSistaV1InstructionFor: aClient! Item was added: + ----- Method: EncoderForSistaV1 class>>isBlockReturnAt:in: (in category 'instruction stream support') ----- + isBlockReturnAt: pc in: method + "Answer whether the bytecode at pc is a return from block." + " 93 01011101 BlockReturn nil + * 94 01011110 BlockReturn Top [* return from enclosing block N, N = Extend A, then jump by Ext B ]" + ^(self nonExtensionBytecodeAt: pc in: method) between: 93 and: 94! Item was added: + ----- Method: EncoderForSistaV1 class>>isBranchIfFalseAt:in: (in category 'instruction stream support') ----- + isBranchIfFalseAt: pc in: method + "Answer whether the bytecode at pc is a conditional branch-if-false." + + " 192-199 11000 iii Pop and Jump 0n False iii +1 (i.e., 1 through 8) + * 239 11101111 iiiiiiii Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0)" + | byte | + byte := self nonExtensionBytecodeAt: pc in: method. + ^byte >= 192 and: [byte <= 199 or: [byte = 239]]! Item was added: + ----- Method: EncoderForSistaV1 class>>isBranchIfTrueAt:in: (in category 'instruction stream support') ----- + isBranchIfTrueAt: pc in: method + "Answer whether the bytecode at pc is a conditional branch-if-true." + + " 184-191 10111 iii Pop and Jump 0n True iii +1 (i.e., 1 through 8) + * 238 11101110 iiiiiiii Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0))" + | byte | + byte := self nonExtensionBytecodeAt: pc in: method. + ^byte >= 184 and: [byte <= 191 or: [byte = 238]]! Item was added: + ----- Method: EncoderForSistaV1 class>>isExtension: (in category 'instruction stream support') ----- + isExtension: bytecode + "Answer if the bytecode is an extension bytecode, i.e. one that extends + the range of the following bytecode." + ^bytecode >= 16rE0 and: [bytecode <= 16rE1]! Item was added: + ----- Method: EncoderForSistaV1 class>>isJumpAt:in: (in category 'instruction stream support') ----- + isJumpAt: pc in: method + "Answer whether the bytecode at pc is an (unconditional) jump." + + " 176-183 10110 iii Jump iii + 1 (i.e., 1 through 8) + * 225 11100001 bbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B) + * 237 11101101 iiiiiiii Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)" + | byte | + byte := self nonExtensionBytecodeAt: pc in: method. + ^byte >= 176 and: [byte <= 183 or: [byte = 237]]! Item was added: + ----- Method: EncoderForSistaV1 class>>isJustPopAt:in: (in category 'instruction stream support') ----- + isJustPopAt: pc in: method + "Answer whether the bytecode at pc is a pop." + + ^(method at: pc) = 216 "216 11011000 Pop Stack Top"! Item was added: + ----- Method: EncoderForSistaV1 class>>isRealSendAt:in: (in category 'instruction stream support') ----- + isRealSendAt: pc in: method + "Answer whether the bytecode at pc is a real message-send, not blockCopy:." + + ^self isSendAt: pc in: method! Item was added: + ----- Method: EncoderForSistaV1 class>>isReturnAt:in: (in category 'instruction stream support') ----- + isReturnAt: pc in: method + "Answer whether the bytecode at pc is a return from block." + " 88-91 010110 ii Return Receiver/true/false/nil + 92 01011100 Return top + 93 01011101 BlockReturn nil + * 94 01011110 BlockReturn Top [* return from enclosing block N, N = Extend A, then jump by Ext B ]" + ^(self nonExtensionBytecodeAt: pc in: method) between: 88 and: 94! Item was added: + ----- Method: EncoderForSistaV1 class>>isReturnSelfFromMethodAt:in: (in category 'instruction stream support') ----- + isReturnSelfFromMethodAt: pc in: method + "Answer whether the bytecode at pc is a return self from method." + + ^(method at: pc) = 88! Item was added: + ----- Method: EncoderForSistaV1 class>>isReturnTopFromMethodAt:in: (in category 'instruction stream support') ----- + isReturnTopFromMethodAt: pc in: method + "Answer whether the bytecode at pc is a return stack top from method." + + ^(method at: pc) = 92! Item was added: + ----- Method: EncoderForSistaV1 class>>isSendAt:in: (in category 'instruction stream support') ----- + isSendAt: pc in: method + "Answer whether the bytecode at pc is a message-send." + + " 96-111 0110 iiii Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:) + 112-119 01110 iii Send Special Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class) + 120 01111000 UNASSIGNED (was: blockCopy:) + 121 01111001 Send Special Message #value + 122-123 0111101 i Send Special Message #i #(#value: #do:) + 124-127 011111 ii Send Special Message #ii #(#new #new: #x #y)) + 128-143 1000 iiii Send Literal Selector #iiii With 0 Argument + 144-159 1001 iiii Send Literal Selector #iiii With 1 Arguments + 160-175 1010 iiii Send Literal Selector #iiii With 2 Arguments + ** 234 11101010 iiiiijjj Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments + ** 235 11101011 iiiiijjj Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" + + | byte | + byte := self nonExtensionBytecodeAt: pc in: method. + ^byte >= 96 + and: [byte <= 175 + or: [byte >= 234 and: [byte <= 235]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>isStoreAt:in: (in category 'instruction stream support') ----- + isStoreAt: pc in: method + "Answer whether the bytecode at pc is a store or store-pop." + + " 200-207 11001 iii Pop and Store Receiver Variable #iii + 208-215 11010 iii Pop and Store Temporary Variable #iii + * 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 240 11110000 iiiiiiii Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256) + * 241 11110001 iiiiiiii Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256) + 242 11110010 iiiiiiii Pop and Store Temporary Variable #iiiiiiii + * 243 11110011 iiiiiiii Store Receiver Variable #iiiiiii (+ Extend A * 256) + * 244 11110100 iiiiiiii Store Literal Variable #iiiiiiii (+ Extend A * 256) + 245 11110110 iiiiiiii Store Temporary Variable #iiiiiiii + + 252 11111100 kkkkkkkk jjjjjjjj Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj + 253 11111101 kkkkkkkk jjjjjjjj Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj" + + | byte | + byte := self nonExtensionBytecodeAt: pc in: method. + ^byte >= 200 + and: [byte <= 215 + or: [(byte between: 240 and: 245) + or: [(byte between: 252 and: 253)]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>isStorePopAt:in: (in category 'instruction stream support') ----- + isStorePopAt: pc in: method + "Answer whether the bytecode at pc is a store or store-pop." + + " 200-207 11001 iii Pop and Store Receiver Variable #iii + 208-215 11010 iii Pop and Store Temporary Variable #iii + * 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 240 11110000 iiiiiiii Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256) + * 241 11110001 iiiiiiii Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256) + 242 11110010 iiiiiiii Pop and Store Temporary Variable #iiiiiiii + + 253 11111101 kkkkkkkk jjjjjjjj Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj" + + | byte | + byte := self nonExtensionBytecodeAt: pc in: method. + ^byte >= 200 + and: [byte <= 215 + or: [(byte between: 240 and: 242) + or: [byte = 253]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>isSyntheticStoreAt:in:for: (in category 'instruction stream support') ----- + isSyntheticStoreAt: pc in: method for: anInstructionStream + "Answer whether the bytecode at pc is a store or store-pop of an indirect temp vector, + which implement mutable closed-over variables in the the closure implementation. + Stores into temp vectors are not real stores. N.B. pcPreviousTo:in:for: is slow, so filter + out any preceding bytecodes other than what looks like a pushNewArrayCode. But the + pcPreviousTo:in:for: is still necessary, since the presence of a pcPreviousTo:in:for: in the + right place is potentially ambiguous, possibly part of a different bytecode sequence." + + ^(self isTempStoreAt: pc in: method) + and: [pc - 2 >= method initialPC + and: [(method at: pc - 2) = self pushNewArrayCode + and: [(method at: pc - 1) <= 127 + and: [pc - 2 = (self pcPreviousTo: pc in: method for: anInstructionStream)]]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>isTempStoreAt:in: (in category 'instruction stream support') ----- + isTempStoreAt: pc in: method + "Answer if the bytecode at pc is a store or store-pop into a temporary variable. + 208-215 11010 iii Pop and Store Temporary Variable #iii + 242 11110010 iiiiiiii Pop and Store Temporary Variable #iiiiiiii + 245 11110110 iiiiiiii Store Temporary Variable #iiiiiiii" + + | byte | + byte := method at: pc. + ^byte >= 208 + and: [byte <= 215 + or: [byte = 242 or: [byte = 245]]]! Item was added: + ----- Method: EncoderForSistaV1 class>>markerOrNilFor: (in category 'compiled method support') ----- + markerOrNilFor: aMethod + "If aMethod is a marker method, answer the symbol used to mark it. Otherwise + answer nil. What is a marker method? It is method with body like + 'self subclassResponsibility' or '^ self subclassResponsibility' + used to indicate ('mark') a special property. + + Marker methods compile to two bytecode forms, this: + self + send: <literal 1> + pop + returnSelf + or this: + self + send: <literal 1> + returnTop" + | expectedHeaderPlusLliteralSize e byte | + expectedHeaderPlusLliteralSize := Smalltalk wordSize * 4. + ^(((e := aMethod endPC - expectedHeaderPlusLliteralSize) = 3 or: [e = 4]) + and: [aMethod numLiterals = 3 + and: [(aMethod at: expectedHeaderPlusLliteralSize + 1) = 16r4C "push self" + and: [(aMethod at: expectedHeaderPlusLliteralSize + 2) = 16r80 "send" + and: [(byte := aMethod at: expectedHeaderPlusLliteralSize + 3) = 16rD8 "pop" or: [byte = 16r5C "returnTop"]]]]]) + ifTrue: [aMethod literalAt: 1]! Item was added: + ----- Method: EncoderForSistaV1 class>>method:refersInBytecodeToLiteral:specialSelectorIndex: (in category 'scanning') ----- + method: method refersInBytecodeToLiteral: aLiteral specialSelectorIndex: specialOrNil + "Answer if method refers to the literal aLiteral in the bytecode, as opposed to in its literal frame." + + " 77 01001101 Push true + 78 01001110 Push false + 79 01001111 Push nil + 80 01010000 Push 0 + 81 01010001 Push 1 + 88-91 010110 ii Return Receiver/true/false/nil + 93 01011101 BlockReturn nil + 96-111 0110 iiii Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:) + 112-119 01110 iii Send Special Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class) + 120 01111000 UNASSIGNED (was: blockCopy:) + 121 01111001 Send Special Message #value + 122-123 0111101 i Send Special Message #i #(#value: #do:) + 124-127 011111 ii Send Special Message #ii #(#new #new: #x #y)) + * 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 225 11100001 sbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B) + * 232 11101000 iiiiiiii Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1) + * 233 11101001 iiiiiiii Push Character #iiiiiiii (+ Extend B * 256) + 249 11111001 xxxxxxxx syyyyyyy Reserved for Push Float" + | byte extended scanner | + specialOrNil ifNotNil: + [byte := specialOrNil + 95. + ^(InstructionStream on: method) scanFor: [:b| b = byte]]. + extended := false. + aLiteral isInteger ifTrue: + [(aLiteral >= -32768 and: [aLiteral <= 32767]) ifFalse: [^false]. + scanner := InstructionStream on: method. + (aLiteral >= 0 and: [aLiteral <= 255]) ifTrue: + [aLiteral <= 1 ifTrue: + [byte := aLiteral + 80. + ^scanner scanFor: [:b| b = byte]]. + ^scanner scanFor: + [:b| + (b = 232 + and: [extended not + and: [scanner followingByte = aLiteral]]) + or: [extended := b = 225. + false]]]. + byte := (aLiteral bitShift: -8) bitAnd: 255. + ^scanner scanFor: + [:b| + (b = 232 + and: [extended + and: [scanner followingByte = (aLiteral bitAnd: 255)]]) + or: [extended := b = 225 and: [scanner followingByte = byte]. + false]]]. + aLiteral isCharacter ifTrue: + [aLiteral asciiValue <= 65535 ifFalse: [^false]. + scanner := InstructionStream on: method. + aLiteral asciiValue <= 255 ifTrue: + [^scanner scanFor: + [:b| + (b = 233 + and: [extended not + and: [scanner followingByte = aLiteral]]) + or: [extended := b = 225. + false]]]. + byte := (aLiteral bitShift: -8) bitAnd: 255. + ^scanner scanFor: + [:b| + (b = 233 + and: [extended + and: [scanner followingByte = (aLiteral bitAnd: 255)]]) + or: [extended := b = 225 and: [scanner followingByte = byte]. + false]]]. + aLiteral == nil ifTrue: + [^(InstructionStream on: method) scanFor: [:b| b = 79 or: [b = 91 or: b = 93]]]. + aLiteral == true ifTrue: + [^(InstructionStream on: method) scanFor: [:b| b = 77 or: [b = 89]]]. + aLiteral == false ifTrue: + [^(InstructionStream on: method) scanFor: [:b| b = 78 or: [b = 90]]]. + + ^false! Item was added: + ----- Method: EncoderForSistaV1 class>>nonExtensionBytecodeAt:in: (in category 'instruction stream support') ----- + nonExtensionBytecodeAt: pc in: method + "Answer the actual bytecode at pc in method, skipping past any preceding extensions." + | thePC bytecode | + thePC := pc. + [self isExtension: (bytecode := method at: thePC)] whileTrue: + [thePC := thePC + (self bytecodeSize: bytecode)]. + ^bytecode! Item was added: + ----- Method: EncoderForSistaV1 class>>nopCode (in category 'bytecode decoding') ----- + nopCode + "Answer the call primitive bytecode, if it exists in the encoder's bytecode set, or nil if not. + 95 01011111 Nop" + ^95! Item was added: + ----- Method: EncoderForSistaV1 class>>pcOfBlockCreationBytecodeForBlockStartingAt:in: (in category 'bytecode decoding') ----- + pcOfBlockCreationBytecodeForBlockStartingAt: startpc in: method + "Answer the pc of the push closure bytecode whose block starts at startpc in method. + May need to back up to include extension bytecodes." + + "* 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 225 11100001 bbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B) + ** 250 11111010 eeiiikkk jjjjjjjj Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions" + | numExtensions | + self assert: (method at: startpc - 3) = 250. + numExtensions := (method at: startpc - 2) >> 6. + ^startpc - 3 - (numExtensions * 2)! Item was added: + ----- Method: EncoderForSistaV1 class>>pushClosureBytecodeSize (in category 'bytecode decoding') ----- + pushClosureBytecodeSize + "Answer the size of the push closure bytecode. + ** 250 11111010 eeiiikkk jjjjjjjj Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions" + ^3! Item was added: + ----- Method: EncoderForSistaV1 class>>pushNewArrayCode (in category 'bytecode decoding') ----- + pushNewArrayCode + "231 11100111 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) + & Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)" + ^231! Item was added: + ----- Method: EncoderForSistaV1 class>>pushNilCode (in category 'bytecode decoding') ----- + pushNilCode + "Answer the pushNil bytecode. + 79 01001111 Push nil" + ^79! Item was added: + ----- Method: EncoderForSistaV1 class>>scanBlockOrNilForLiteral: (in category 'scanning') ----- + scanBlockOrNilForLiteral: aLiteral + "Answer a block argument for CompiledMethod>>#scanFor: that answers + if the method refers to the literal implicitly via a special bytecode. + If the literal is not accessible via a special bytecode, answer nil." + | value hi lo unextended | + + "96-111 0110 iiii Send Arithmetic Message #iiii (+ - < > <= >= = ~= * / \\ @ bitShift: // bitAnd: bitOr:) + 112-119 01110 iii Send Special Message #iii + 0 (at: at:put: size next nextPut: atEnd == class)" + aLiteral isSymbol ifTrue: + [value := 96 + ((Smalltalk specialSelectors indexOf: aLiteral ifAbsent: [^nil]) // 2). + ^[:byte| byte = value]]. + + "80 01010000 Push 0 + 81 01010001 Push 1 + 232 11101000 iiiiiiii Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, d=0, s=1)" + aLiteral isInteger ifTrue: + [aLiteral >= 0 ifTrue: + [aLiteral <= 1 ifTrue: + [value := aLiteral + 80. + ^[:byte| byte = value]]. + aLiteral <= 255 ifTrue: + [unextended := true. "Don't be fooled by extended cases with the same least significant byte!!" + ^[:b1 :b2| | found | + found := b1 = 232 and: [b2 = aLiteral and: [unextended]]. + unextended := b1 ~= 16rE1. + found]]]. + (aLiteral between: -32768 and: 32767) ifFalse: [^nil]. + lo := aLiteral bitAnd: 255. + hi := (aLiteral bitShift: -8) bitAnd: 255. + ^[:b1 :b2 :b3 :b4| b1 = 16rE1 and: [b2 = hi and: [b3 = 232 and: [b4 = lo]]]]]. + + "233 11101001 iiiiiiii Push Character #iiiiiiii (+ Extend B * 256)" + aLiteral isCharacter ifTrue: + [(value := aLiteral asInteger) <= 255 ifTrue: + [unextended := true. "Don't be fooled by extended cases with the same least significant byte!!" + ^[:b1 :b2| | found | + found := b1 = 233 and: [b2 = value and: [unextended]]. + unextended := b1 ~= 16rE1. + found]]. + ^value <= 65535 ifTrue: + [lo := value bitAnd: 255. + hi := (value bitShift: -8) bitAnd: 255. + [:b1 :b2 :b3 :b4| b1 = 16rE1 and: [b2 = hi and: [b3 = 233 and: [b4 = lo]]]]]]. + + "77 01001101 Push true + 78 01001110 Push false + 79 01001111 Push nil + 88-91 010110 ii Return Receiver/true/false/nil + 93 01011101 BlockReturn nil" + aLiteral == true ifTrue: + [^[:byte| byte = 77 or: [byte = 89]]]. + aLiteral == false ifTrue: + [^[:byte| byte = 78 or: [byte = 90]]]. + aLiteral == nil ifTrue: + [^[:byte| byte = 79 or: [byte = 91 or: [byte = 93]]]]. + ^nil! Item was added: + ----- Method: EncoderForSistaV1 class>>selectorToSendOrItselfFor:in:at: (in category 'instruction stream support') ----- + selectorToSendOrItselfFor: anInstructionStream in: method at: pc + "If anInstructionStream is at a send bytecode then answer the send's selector, + otherwise answer anInstructionStream itself. The rationale for answering + anInstructionStream instead of, say, nil, is that potentially any existing object + can be used as a selector, but since anInstructionStream postdates the method, + it can't be one of them. + + The complication is that for convenience we allow the pc to point to the + raw send bytecode after its extension(s), or at the extension(s) preceding it. + 96-111 0110 iiii Send Arithmetic Message #iiii (+ - < > <= >= = ~= * / \\ @ bitShift: // bitAnd: bitOr:) + 112-119 01110 iii Send Special Message #iii + 0 (at: at:put: size next nextPut: atEnd == class) + 120-127 01111 iii Send Special Message #iii + 8 (~~ value value: do: new new: x y) + 128-143 1000 iiii Send Literal Selector #iiii With 0 Argument + 144-159 1001 iiii Send Literal Selector #iiii With 1 Arguments + 160-175 1010 iiii Send Literal Selector #iiii With 2 Arguments + * 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 225 11100001 bbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B) + ** 234 11101010 iiiiijjj Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments + ** 235 11101011 iiiiijjj ExtendB < 64 + ifTrue: [Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments] + ifFalse: [Send To Superclass of Stacked Class Literal Selector #iiiii (+ Extend A * 32) with jjj (+ (Extend B bitAnd: 63) * 8) Arguments" + + | byte | + byte := method at: pc. + byte < 96 ifTrue: + [^anInstructionStream]. + byte <= 175 ifTrue: + ["special byte or short send" + ^byte >= 128 + ifTrue: [method literalAt: (byte bitAnd: 15) + 1] + ifFalse: [Smalltalk specialSelectorAt: byte - 95]]. + byte < 234 ifTrue: "need to check for either extension cuz order of extensions is not restricted. so extB could precede extA" + [(byte >= 224 and: [byte <= 225]) ifTrue: + [^self extensionsAt: pc in: method into: + [:extA :extB :nExtBytes| | byteAfter index | + byteAfter := method at: pc + nExtBytes. + (byteAfter >= 234 and: [byteAfter <= 235]) + ifTrue: + [index := ((method at: pc + nExtBytes + 1) bitShift: -3) + (extA bitShift: 5). + method literalAt: index + 1] + ifFalse: [anInstructionStream]]]. + ^anInstructionStream]. + byte > 235 ifTrue: + [^anInstructionStream]. + "they could be extended..." + ^self extensionsFor: pc in: method into: + [:extA :extB :nExtBytes| | index | + index := ((method at: pc + 1) bitShift: -3) + (extA bitShift: 5). + method literalAt: index + 1]! Item was added: + ----- Method: EncoderForSistaV1 class>>stackDeltaForPrimitive:in: (in category 'bytecode decoding') ----- + stackDeltaForPrimitive: primitiveIndex in: method + "Answer the stack delta for the callPrimitive: bytecode (see my class comment). + There is no delta for non-inlined primitives (its implicitly 0 - method numArgs). + Inlined primitives are grouped by the thousand by argument count, 32 args max ;-)." + ^primitiveIndex < 32678 + ifTrue: [0] + ifFalse: [primitiveIndex - 32768 // 1000]! Item was added: + ----- Method: EncoderForSistaV1 class>>superSendScanBlockUsing: (in category 'instruction stream support') ----- + superSendScanBlockUsing: scanner + "Answer a block argument for InstructionStream>>scanFor: + that answers true for super sends." + + "* 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + * 225 11100001 sbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B) + ** 235 11101011 iiiiijjj Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" + + ^[:instr | instr = 235]! Item was added: + ----- Method: EncoderForSistaV1 class>>supportsClosures (in category 'compiled method support') ----- + supportsClosures + "Answer if the instruction set supports closures (contains + closure creation and indirect temp access bytecodes)." + + ^true! Item was added: + ----- Method: EncoderForSistaV1 class>>unusedBytecode (in category 'bytecode decoding') ----- + unusedBytecode + "Answer the opcode of a single-byte unused bytecode, if it exists in the encoder's bytecode set, or nil if not." + ^223! Item was added: + ----- Method: EncoderForSistaV1>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') ----- + computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex + numTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + numLits > 65535 ifTrue: + [^self error: 'Cannot compile -- too many literals']. + ^SmallInteger minVal "sign bit is the flag for the alternative bytecode set" + + (numArgs bitShift: 24) + + (numTemps bitShift: 18) + "+ (largeBit bitShift: 17)" "largeBit gets filled in later" + + numLits + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])! Item was added: + ----- Method: EncoderForSistaV1>>genBranchPopFalse: (in category 'bytecode generation') ----- + genBranchPopFalse: distance + (distance > 0 and: [distance < 9]) ifTrue: + ["192-199 11000 iii Pop and Jump 0n False iii + 1 (i.e., 1 through 8)" + stream nextPut: 191 + distance. + ^self]. + ^self genBranchPopFalseLong: distance! Item was added: + ----- Method: EncoderForSistaV1>>genBranchPopFalseLong: (in category 'bytecode generation') ----- + genBranchPopFalseLong: distance + "239 11101111 iiiiiiii Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0) " + | distanceMod256 | + (distance < 0 or: [distance > 32767]) ifTrue: + [^self outOfRangeError: 'distance' index: distance range: 0 to: 32767]. + distanceMod256 := (distance < 0 or: [distance > 255]) + ifTrue: + [self genUnsignedSingleExtendB: (distance bitShift: -8). + distance bitAnd: 255] + ifFalse: [distance]. + stream + nextPut: 239; + nextPut: distanceMod256! Item was added: + ----- Method: EncoderForSistaV1>>genBranchPopTrue: (in category 'bytecode generation') ----- + genBranchPopTrue: distance + (distance > 0 and: [distance < 9]) ifTrue: + ["184-191 10111 iii Pop and Jump 0n True iii + 1 (i.e., 1 through 8)" + stream nextPut: 183 + distance. + ^self]. + ^self genBranchPopTrueLong: distance! Item was added: + ----- Method: EncoderForSistaV1>>genBranchPopTrueLong: (in category 'bytecode generation') ----- + genBranchPopTrueLong: distance + "238 11101110 iiiiiiii Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0)" + | distanceMod256 | + (distance < 0 or: [distance > 32767]) ifTrue: + [^self outOfRangeError: 'distance' index: distance range: 0 to: 32767]. + (distance > 0 and: [distance < 9]) ifTrue: + ["184-191 10111 iii Pop and Jump 0n True iii + 1 (i.e., 1 through 8)" + stream nextPut: 183 + distance. + ^self]. + distanceMod256 := (distance < 0 or: [distance > 255]) + ifTrue: + [self genUnsignedSingleExtendB: (distance bitShift: -8). + distance bitAnd: 255] + ifFalse: [distance]. + stream + nextPut: 238; + nextPut: distanceMod256! Item was added: + ----- Method: EncoderForSistaV1>>genCallInlinePrimitive: (in category 'bytecode generation') ----- + genCallInlinePrimitive: primitiveIndex + " 248 (2) 11111000 iiiiiiii mssjjjjj Call Primitive #iiiiiiii + (jjjjj * 256) + m=1 means inlined primitive, no hard return after execution. + ss defines the unsafe operation set used to encode the operations. + (ss = 0 means sista unsafe operations, ss = 01 means lowcode operations, other numbers are not used)" + "N.B. We could have made CallPrimitive a 2-byte code taking an extension, but that would + complicate the VM's determination of the primitive number and the primitive error code + store since the extension, being optional, would make the sequence variable length." + (primitiveIndex < 1 or: [primitiveIndex > 32767]) ifTrue: + [self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 32767]. + stream + nextPut: 248; + nextPut: (primitiveIndex bitAnd: 255); + nextPut: (primitiveIndex bitShift: -8) + 128! Item was added: + ----- Method: EncoderForSistaV1>>genCallPrimitive: (in category 'bytecode generation') ----- + genCallPrimitive: primitiveIndex + "248 (2) 11111000 iiiiiiii mssjjjjj Call Primitive #iiiiiiii + (jjjjj * 256) + m=1 means inlined primitive, no hard return after execution. + ss defines the unsafe operation set used to encode the operations. + (ss = 0 means sista unsafe operations, ss = 01 means lowcode operations, other numbers are not used)" + "N.B. We could have made CallPrimitive a 2-byte code taking an extension, but that would + complicate the VM's determination of the primitive number and the primitive error code + store since the extension, being optional, would make the sequence variable length." + (primitiveIndex < 1 or: [primitiveIndex > 32767]) ifTrue: + [self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 32767]. + stream + nextPut: 248; + nextPut: (primitiveIndex bitAnd: 255); + nextPut: (primitiveIndex bitShift: -8)! Item was added: + ----- Method: EncoderForSistaV1>>genDup (in category 'bytecode generation') ----- + genDup + "83 01010011 Duplicate Stack Top" + stream nextPut: 83! Item was added: + ----- Method: EncoderForSistaV1>>genInlineSmallIntegerAdd (in category 'in-line primitive generation') ----- + genInlineSmallIntegerAdd + ^self genCallInlinePrimitive: 0! Item was added: + ----- Method: EncoderForSistaV1>>genJump: (in category 'bytecode generation') ----- + genJump: distance + (distance > 0 and: [distance < 9]) ifTrue: + ["176-183 10110 iii Jump iii + 1 (i.e., 1 through 8)" + stream nextPut: 175 + distance. + ^self]. + "237 11101101 iiiiiiii Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)" + ^self genJumpLong: distance! Item was added: + ----- Method: EncoderForSistaV1>>genJumpLong: (in category 'bytecode generation') ----- + genJumpLong: distance + "237 11101101 iiiiiiii Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)" + (distance between: -32768 and: 32767) ifFalse: + [^self outOfRangeError: 'index' index: distance range: -32768 to: 32767]. + (distance < 0 or: [distance > 255]) ifTrue: + [self genSignedSingleExtendB: (distance bitShift: -8)]. + stream + nextPut: 237; + nextPut: (distance bitAnd: 255)! Item was added: + ----- Method: EncoderForSistaV1>>genNop (in category 'bytecode generation') ----- + genNop + "95 01011111 Nop" + stream nextPut: 95! Item was added: + ----- Method: EncoderForSistaV1>>genPop (in category 'bytecode generation') ----- + genPop + "216 11011000 Pop Stack Top" + stream nextPut: 216! Item was added: + ----- Method: EncoderForSistaV1>>genPushCharacter: (in category 'bytecode generation') ----- + genPushCharacter: aCharacterOrCode + "233 11101001 i i i i i i i i Push Character #iiiiiiii (+ Extend A * 256)" + "Why restrict the range to 16 bits when we could encode arbitrary 32-bit Characters? + Well, 16 bits requires 4 bytes (extA + byte, 233 + byte) and so beyond this range we + lose space verses a single-byte pushLiteral and a 4 byte Character literal on 32-bits. + And generating the same bytecode on 64-bit and 32-bit versions is important if we + want to be able to load binary code from one to the other (e.g. via Fuel)." + | code | + code := aCharacterOrCode isInteger ifTrue: [aCharacterOrCode] ifFalse: [aCharacterOrCode asInteger]. + (code < 0 or: [code > 65535]) ifTrue: + [^self outOfRangeError: 'character' index: code range: 0 to: 65535]. + (code > 255) ifTrue: + [self genUnsignedSingleExtendA: (code bitShift: -8)]. + stream + nextPut: 233; + nextPut: (code bitAnd: 255)! Item was added: + ----- Method: EncoderForSistaV1>>genPushClosureCopyNumCopiedValues:numArgs:jumpSize: (in category 'bytecode generation') ----- + genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: jumpSize + "250 11111010 eeiiikkk jjjjjjjj Push Closure Num Copied iii (+ Ext A // 16 * 8) Num Args kkk (+ Ext A \\ 16 * 8) BlockSize jjjjjjjj (+ Ext B * 256). ee = num extensions" + "Including numExtensions makes decoding the bytecode quicker since it obviates having to scan from the beginning of a method." + | numExtensions numCopiedMod8 numArgsMod8 extA | + (jumpSize < 0 or: [jumpSize > 65535]) ifTrue: + [^self outOfRangeError: 'block size' index: jumpSize range: 0 to: 65535]. + (numCopied < 0 or: [numCopied > 127]) ifTrue: + [^self outOfRangeError: 'num copied' index: numCopied range: 0 to: 127]. + (numArgs < 0 or: [numArgs > 127]) ifTrue: + [^self outOfRangeError: 'num args' index: numArgs range: 0 to: 127]. + extA := numExtensions := 0. + (numArgsMod8 := numArgs) > 7 ifTrue: + [extA := numArgs // 8. + numArgsMod8 := numArgsMod8 \\ 8]. + (numCopiedMod8 := numCopied) > 7 ifTrue: + [extA := extA + (numCopied // 8 * 16). + numCopiedMod8 := numCopiedMod8 \\ 8]. + extA ~= 0 ifTrue: + [self genUnsignedSingleExtendA: extA. + numExtensions := 1]. + jumpSize > 255 ifTrue: + [numExtensions := numExtensions + 1. + self genUnsignedSingleExtendB: jumpSize // 256]. + stream + nextPut: 250; + nextPut: (numExtensions bitShift: 6) + (numCopiedMod8 bitShift: 3) + numArgsMod8; + nextPut: (jumpSize bitAnd: 16rFF)! Item was added: + ----- Method: EncoderForSistaV1>>genPushConsArray: (in category 'bytecode generation') ----- + genPushConsArray: size + (size < 0 or: [size > 127]) ifTrue: + [^self outOfRangeError: 'size' index: size range: 0 to: 127]. + "231 11100111 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) + & Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)" + stream + nextPut: 231; + nextPut: size + 128! Item was added: + ----- Method: EncoderForSistaV1>>genPushFullClosure:numCopied: (in category 'bytecode generation') ----- + genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied + "By default the closure will have an outer context and the receiver will be fetched from the current context" + self genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: false ignoreOuterContext: false! Item was added: + ----- Method: EncoderForSistaV1>>genPushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'bytecode generation') ----- + genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: receiverOnStack ignoreOuterContext: ignoreOuterContext + "* 249 11111001 xxxxxxxx siyyyyyy push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1" + | extendedIndex | + (numCopied < 0 or: [numCopied > 64]) ifTrue: + [self outOfRangeError: 'num copied' index: numCopied range: 1 to: 64]. + (compiledBlockLiteralIndex < 0 or: [compiledBlockLiteralIndex > 32767]) ifTrue: + [^self outOfRangeError: 'index' index: compiledBlockLiteralIndex range: 0 to: 32767]. + (extendedIndex := compiledBlockLiteralIndex) > 255 ifTrue: + [self genUnsignedSingleExtendA: extendedIndex // 256. + extendedIndex := extendedIndex \\ 256]. + stream + nextPut: 249; + nextPut: extendedIndex; + nextPut: receiverOnStack asBit << 7 + (ignoreOuterContext asBit << 6) + numCopied! Item was added: + ----- Method: EncoderForSistaV1>>genPushInstVar: (in category 'bytecode generation') ----- + genPushInstVar: instVarIndex + (instVarIndex between: 0 and: 15) ifTrue: + ["0-15 0000iiii Push Receiver Variable #iiii" + stream nextPut: 0 + instVarIndex. + ^self]. + self genPushInstVarLong: instVarIndex! Item was added: + ----- Method: EncoderForSistaV1>>genPushInstVarLong: (in category 'bytecode generation') ----- + genPushInstVarLong: instVarIndex + "226 11100010 i i i i i i i i Push Receiver Variable #iiiiiiii (+ Extend A * 256)" + "See also MaybeContextInstanceVariableNode" + (instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue: + [^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 65535]. + instVarIndex > 255 ifTrue: + [self genUnsignedSingleExtendA: instVarIndex // 256]. + stream + nextPut: 226; + nextPut: instVarIndex \\ 256! Item was added: + ----- Method: EncoderForSistaV1>>genPushInteger: (in category 'bytecode generation') ----- + genPushInteger: anInteger + "80 01010000 Push 0 + 81 01010001 Push 1 + 232 11101000 i i i i i i i i Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)" + "Why restrict the range to 16 bits when we could encode arbitrarily large integers? + Well, 16 bits requires 4 bytes (extB + byte, 78 + byte) and so beyond this range we lose space + verses a single-byte pushLiteral and a 4 byte integer literal on 32-bits. And generating the same + bytecode on 64-bit and 32-bit is important if we want to be able to load binary code from one to + the other (e.g. via Fuel)." + anInteger = 0 ifTrue: + [stream nextPut: 80. + ^self]. + anInteger = 1 ifTrue: + [stream nextPut: 81. + ^self]. + (anInteger < -32768 or: [anInteger > 32767]) ifTrue: + [^self outOfRangeError: 'integer' index: anInteger range: -32768 to: 32767]. + (anInteger < 0 or: [anInteger > 255]) ifTrue: + [self genSignedSingleExtendB: (anInteger bitShift: -8)]. + stream + nextPut: 232; + nextPut: (anInteger bitAnd: 255)! Item was added: + ----- Method: EncoderForSistaV1>>genPushLiteral: (in category 'bytecode generation') ----- + genPushLiteral: literalIndex + | extendedIndex | + (literalIndex < 0 or: [literalIndex > 65535]) ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65535]. + literalIndex < 32 ifTrue: + ["32-63 001iiiii Push Literal #iiiii" + stream nextPut: 32 + literalIndex. + ^self]. + "228 11100100 i i i i i i i i Push Literal #iiiiiiii (+ Extend A * 256)" + (extendedIndex := literalIndex) > 255 ifTrue: + [self genUnsignedSingleExtendA: extendedIndex // 256. + extendedIndex := extendedIndex \\ 256]. + stream + nextPut: 228; + nextPut: extendedIndex! Item was added: + ----- Method: EncoderForSistaV1>>genPushLiteralVar: (in category 'bytecode generation') ----- + genPushLiteralVar: literalIndex + | extendedIndex | + (literalIndex < 0 or: [literalIndex > 65535]) ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65535]. + literalIndex < 16 ifTrue: + ["16-31 0001 i i i i Push Literal Variable #iiii" + stream nextPut: 16 + literalIndex. + ^self]. + "227 11100011 i i i i i i i i Push Literal Variable #iiiiiiii (+ Extend A * 256)" + (extendedIndex := literalIndex) > 255 ifTrue: + [self genUnsignedSingleExtendA: extendedIndex // 256. + extendedIndex := extendedIndex \\ 256]. + stream + nextPut: 227; + nextPut: extendedIndex! Item was added: + ----- Method: EncoderForSistaV1>>genPushNewArray: (in category 'bytecode generation') ----- + genPushNewArray: size + (size < 0 or: [size > 127]) ifTrue: + [^self outOfRangeError: 'size' index: size range: 0 to: 127]. + "231 11100111 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) + & Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)" + stream + nextPut: 231; + nextPut: size! Item was added: + ----- Method: EncoderForSistaV1>>genPushReceiver (in category 'bytecode generation') ----- + genPushReceiver + "76 01001100 Push Receiver" + stream nextPut: 76! Item was added: + ----- Method: EncoderForSistaV1>>genPushRemoteTemp:inVectorAt: (in category 'bytecode generation') ----- + genPushRemoteTemp: tempIndex inVectorAt: tempVectorIndex + "251 11111011 kkkkkkkk sjjjjjjj Push Temp At kkkkkkkk In Temp Vector At: jjjjjjj, s = 1 implies remote inst var access instead of remote temp vector access" + (tempIndex < 0 or: [tempIndex >= 256]) ifTrue: + [^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255]. + (tempVectorIndex < 0 or: [tempVectorIndex >= 128]) ifTrue: + [^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 127]. + stream + nextPut: 251; + nextPut: tempIndex; + nextPut: tempVectorIndex! Item was added: + ----- Method: EncoderForSistaV1>>genPushSpecialLiteral: (in category 'bytecode generation') ----- + genPushSpecialLiteral: aLiteral + "77 01001101 Push true + 78 01001110 Push false + 79 01001111 Push nil + 80 01010000 Push 0 + 81 01010001 Push 1 + 232 11101000 iiiiiiii Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1) + 233 11101001 i i i i i i i i Push Character #iiiiiiii (+ Extend B * 256)" + | index | + aLiteral isInteger ifTrue: + [aLiteral == 0 ifTrue: + [stream nextPut: 80. + ^self]. + aLiteral == 1 ifTrue: + [stream nextPut: 81. + ^self]. + ^self genPushInteger: aLiteral]. + aLiteral isCharacter ifTrue: + [^self genPushCharacter: aLiteral]. + index := #(true false nil) + indexOf: aLiteral + ifAbsent: [^self error: 'push special literal: ', aLiteral printString, ' is not one of true false nil']. + stream nextPut: 76 + index! Item was added: + ----- Method: EncoderForSistaV1>>genPushTemp: (in category 'bytecode generation') ----- + genPushTemp: tempIndex + (tempIndex < 0 or: [tempIndex > 63]) ifTrue: + [^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63]. + tempIndex < 12 ifTrue: + ["64-71 01000 i i i Push Temporary Variable #iii + 72-75 010010 i i Push Temporary Variable #ii + 8" + stream nextPut: 64 + tempIndex. + ^self]. + "229 11100101 i i i i i i i i Push Temporary Variable #iiiiiiii" + stream + nextPut: 229; + nextPut: tempIndex! Item was added: + ----- Method: EncoderForSistaV1>>genPushThisContext (in category 'bytecode generation') ----- + genPushThisContext + "82 01010010 Push thisContext, (then e.g. Extend B 1 = push thisProcess)" + stream nextPut: 82! Item was added: + ----- Method: EncoderForSistaV1>>genReturnNilToCaller (in category 'bytecode generation') ----- + genReturnNilToCaller + "93 01011101 BlockReturn nil [* return from enclosing block N, ExtA]" + "If extended, the least significant bit of the extension determines if we return to the caller or not + and the most significant bits determine how many levels of the static chain to return from. + ExtA = iiiiiiij + iiiiiii=0,j=0 => return to caller + iiiiiii=0,j=1 => illegal + iiiiiii=1,j=0 => return to outerContext + iiiiiii=1,j=1 => return to outerContext sender/return from outerContext + iiiiiii=2,j=0 => return to outerContext outerContext + iiiiiii=2,j=1 => return to outerContext outerContext sender/return from outerContext outerContext + etc" + + stream nextPut: 93! Item was added: + ----- Method: EncoderForSistaV1>>genReturnReceiver (in category 'bytecode generation') ----- + genReturnReceiver + "88-91 010110 ii Return Receiver/true/false/nil" + stream nextPut: 88! Item was added: + ----- Method: EncoderForSistaV1>>genReturnSpecialLiteral: (in category 'bytecode generation') ----- + genReturnSpecialLiteral: aLiteral + "88-91 010110 ii Return Receiver/true/false/nil" + | index | + index := #(true false nil) indexOf: aLiteral ifAbsent: 0. + index = 0 ifTrue: + [^self error: 'return special literal: ', aLiteral printString, ' is not one of true false nil']. + stream nextPut: 88 + index! Item was added: + ----- Method: EncoderForSistaV1>>genReturnTop (in category 'bytecode generation') ----- + genReturnTop + "92 1011100 Return Stack Top From Message" + stream nextPut: 92! Item was added: + ----- Method: EncoderForSistaV1>>genReturnTopToCaller (in category 'bytecode generation') ----- + genReturnTopToCaller + "94 01011110 Return Stack Top From Block [* return from enclosing block N, ExtA]" + "If extended, the least significant bit of the extension determines if we return to the caller or not + and the most significant bits determine how many levels of the static chain to return from. + ExtA = iiiiiiij + iiiiiii=0,j=0 => return to caller + iiiiiii=0,j=1 => illegal + iiiiiii=1,j=0 => return to outerContext + iiiiiii=1,j=1 => return to outerContext sender/return from outerContext + iiiiiii=2,j=0 => return to outerContext outerContext + iiiiiii=2,j=1 => return to outerContext outerContext sender/return from outerContext outerContext + etc" + + stream nextPut: 94! Item was added: + ----- Method: EncoderForSistaV1>>genSend:numArgs: (in category 'bytecode generation') ----- + genSend: selectorLiteralIndex numArgs: nArgs + | extendedIndex extendedNArgs | + (selectorLiteralIndex < 0 or: [selectorLiteralIndex > 65535]) ifTrue: + [^self outOfRangeError: 'selectorLiteralIndex' index: selectorLiteralIndex range: 0 to: 65535]. + (nArgs < 0 or: [nArgs > 31]) ifTrue: + [^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"]. + (selectorLiteralIndex < 16 and: [nArgs < 3]) ifTrue: + ["128-143 1000 iiii Send Literal Selector #iiii With 0 Argument + 144-159 1001 iiii Send Literal Selector #iiii With 1 Arguments + 160-175 1010 iiii Send Literal Selector #iiii With 2 Arguments" + stream nextPut: 128 + (nArgs * 16) + selectorLiteralIndex. + ^self]. + (extendedIndex := selectorLiteralIndex) > 31 ifTrue: + [self genUnsignedMultipleExtendA: extendedIndex // 32. + extendedIndex := extendedIndex \\ 32]. + (extendedNArgs := nArgs) > 7 ifTrue: + [self genUnsignedSingleExtendB: extendedNArgs // 8. + extendedNArgs := extendedNArgs \\ 8]. + "234 11101010 i i i i i j j j Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" + stream + nextPut: 234; + nextPut: extendedNArgs + (extendedIndex * 8)! Item was added: + ----- Method: EncoderForSistaV1>>genSendDirectedSuper:numArgs: (in category 'bytecode generation') ----- + genSendDirectedSuper: selectorLiteralIndex numArgs: nArgs + | extendedIndex | + (selectorLiteralIndex < 0 or: [selectorLiteralIndex > 65535]) ifTrue: + [^self outOfRangeError: 'selectorLiteralIndex' index: selectorLiteralIndex range: 0 to: 65535]. + (nArgs < 0 or: [nArgs > 31]) ifTrue: + [^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"]. + (extendedIndex := selectorLiteralIndex) > 31 ifTrue: + [self genUnsignedMultipleExtendA: extendedIndex // 32. + extendedIndex := extendedIndex \\ 32]. + "Bit 6 of the ExtB byte is the directed send flag. Bit 6 allows for future expansion to up to 255 args." + self genUnsignedSingleExtendB: nArgs // 8 + 64. + "235 11101011 iiiiijjj Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" + stream + nextPut: 235; + nextPut: nArgs \\ 8 + (extendedIndex * 8)! Item was added: + ----- Method: EncoderForSistaV1>>genSendSpecial:numArgs: (in category 'bytecode generation') ----- + genSendSpecial: specialSelectorIndex numArgs: nArgs + self assert: (specialSelectorIndex between: 1 and: Smalltalk specialSelectorSize). + self assert: nArgs = (Smalltalk specialNargsAt: specialSelectorIndex). + "Special selector sends. + 96-111 0110 iiii Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:) + 112-119 01110 iii Send Special Message #iii #(#at: #at:put: #size ? ? ? #'==' class ? value value: ? ? ? ? ?)" + + stream nextPut: specialSelectorIndex + 95! Item was added: + ----- Method: EncoderForSistaV1>>genSendSuper:numArgs: (in category 'bytecode generation') ----- + genSendSuper: selectorLiteralIndex numArgs: nArgs + | extendedIndex extendedNArgs | + (selectorLiteralIndex < 0 or: [selectorLiteralIndex > 65535]) ifTrue: + [^self outOfRangeError: 'selectorLiteralIndex' index: selectorLiteralIndex range: 0 to: 65535]. + (nArgs < 0 or: [nArgs > 31]) ifTrue: + [^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"]. + (extendedIndex := selectorLiteralIndex) > 31 ifTrue: + [self genUnsignedMultipleExtendA: extendedIndex // 32. + extendedIndex := extendedIndex \\ 32]. + (extendedNArgs := nArgs) > 7 ifTrue: + [self genUnsignedSingleExtendB: extendedNArgs // 8. + extendedNArgs := extendedNArgs \\ 8]. + "235 11101011 iiiiijjj Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" + stream + nextPut: 235; + nextPut: extendedNArgs + (extendedIndex * 8)! Item was added: + ----- Method: EncoderForSistaV1>>genSignedSingleExtendB: (in category 'bytecode generation') ----- + genSignedSingleExtendB: extendedIndex + (extendedIndex between: -128 and: 127) ifFalse: + [^self outOfRangeError: 'index' index: extendedIndex range: -128 to: 127]. + "225 11100001 sbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B)" + stream + nextPut: 225; + nextPut: (extendedIndex >= 0 ifTrue: [extendedIndex] ifFalse: [extendedIndex + 256]) ! Item was added: + ----- Method: EncoderForSistaV1>>genStoreInstVar: (in category 'bytecode generation') ----- + genStoreInstVar: instVarIndex + "243 11110011 iiiiiiii Store Receiver Variable #iiiiiii (+ Extend A * 256)" + self genStoreInstVarLong: instVarIndex! Item was added: + ----- Method: EncoderForSistaV1>>genStoreInstVarLong: (in category 'bytecode generation') ----- + genStoreInstVarLong: instVarIndex + "243 11110011 iiiiiiii Store Receiver Variable #iiiiiii (+ Extend A * 256)" + (instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue: + [^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 65535]. + instVarIndex > 255 ifTrue: + [self genUnsignedSingleExtendA: instVarIndex // 256]. + stream + nextPut: 243; + nextPut: instVarIndex \\ 256! Item was added: + ----- Method: EncoderForSistaV1>>genStoreLiteralVar: (in category 'bytecode generation') ----- + genStoreLiteralVar: literalIndex + "244 11110100 iiiiiiii Store Literal Variable #iiiiiiii (+ Extend A * 256)" + (literalIndex < 0 or: [literalIndex > 65535]) ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65535]. + literalIndex > 255 ifTrue: + [self genUnsignedSingleExtendA: literalIndex // 256]. + stream + nextPut: 244; + nextPut: literalIndex \\ 256! Item was added: + ----- Method: EncoderForSistaV1>>genStorePopInstVar: (in category 'bytecode generation') ----- + genStorePopInstVar: instVarIndex + "200-207 11001 iii Pop and Store Receiver Variable #iii + 240 11110000 iiiiiiii Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)" + (instVarIndex < 0 or: [instVarIndex > 7]) ifTrue: + [^self genStorePopInstVarLong: instVarIndex]. + stream nextPut: 200 + instVarIndex! Item was added: + ----- Method: EncoderForSistaV1>>genStorePopInstVarLong: (in category 'bytecode generation') ----- + genStorePopInstVarLong: instVarIndex + "240 11110000 iiiiiiii Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)" + (instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue: + [^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 65535]. + instVarIndex > 255 ifTrue: + [self genUnsignedSingleExtendA: instVarIndex // 256]. + stream + nextPut: 240; + nextPut: instVarIndex \\ 256! Item was added: + ----- Method: EncoderForSistaV1>>genStorePopLiteralVar: (in category 'bytecode generation') ----- + genStorePopLiteralVar: literalIndex + "241 11110001 iiiiiiii Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)" + (literalIndex < 0 or: [literalIndex > 65535]) ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65535]. + literalIndex > 255 ifTrue: + [self genUnsignedSingleExtendA: literalIndex // 256]. + stream + nextPut: 241; + nextPut: literalIndex \\ 256! Item was added: + ----- Method: EncoderForSistaV1>>genStorePopRemoteTemp:inVectorAt: (in category 'bytecode generation') ----- + genStorePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex + "* 253 (3) 11111101 kkkkkkkk sjjjjjjj Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjj s = 1 implies remote inst var access instead of remote temp vector access" + (tempIndex < 0 or: [tempIndex >= 256]) ifTrue: + [^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255]. + (tempVectorIndex < 0 or: [tempVectorIndex >= 128]) ifTrue: + [^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 127]. + stream + nextPut: 253; + nextPut: tempIndex; + nextPut: tempVectorIndex! Item was added: + ----- Method: EncoderForSistaV1>>genStorePopTemp: (in category 'bytecode generation') ----- + genStorePopTemp: tempIndex + "208-215 11010 iii Pop and Store Temporary Variable #iii + 242 11110010 iiiiiiii Pop and Store Temporary Variable #iiiiiiii" + (tempIndex < 0 or: [tempIndex > 63]) ifTrue: + [^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63]. + tempIndex < 8 ifTrue: + [stream nextPut: 208 + tempIndex. + ^self]. + stream + nextPut: 242; + nextPut: tempIndex! Item was added: + ----- Method: EncoderForSistaV1>>genStoreRemoteTemp:inVectorAt: (in category 'bytecode generation') ----- + genStoreRemoteTemp: tempIndex inVectorAt: tempVectorIndex + "*252 (3) 11111100 kkkkkkkk sjjjjjjj Store Temp At kkkkkkkk In Temp Vector At: jjjjjjj s = 1 implies remote inst var access instead of remote temp vector access" + (tempIndex < 0 or: [tempIndex >= 256]) ifTrue: + [^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255]. + (tempVectorIndex < 0 or: [tempVectorIndex >= 128]) ifTrue: + [^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 127]. + stream + nextPut: 252; + nextPut: tempIndex; + nextPut: tempVectorIndex! Item was added: + ----- Method: EncoderForSistaV1>>genStoreTemp: (in category 'bytecode generation') ----- + genStoreTemp: tempIndex + "245 11110110 iiiiiiii Store Temporary Variable #iiiiiiii" + (tempIndex < 0 or: [tempIndex > 63]) ifTrue: + [^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63]. + stream + nextPut: 245; + nextPut: tempIndex! Item was added: + ----- Method: EncoderForSistaV1>>genTrapIfNotInstanceOf: (in category 'bytecode generation') ----- + genTrapIfNotInstanceOf: literalIndex + "* 236 11101100 iiiiiiii Trap If Not Instance Of Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)" + + | extendedIndex | + (literalIndex < 0 or: [literalIndex > 65535]) ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65536]. + (extendedIndex := literalIndex) > 255 ifTrue: + [self genUnsignedSingleExtendA: extendedIndex // 256. + extendedIndex := extendedIndex \\ 256]. + stream + nextPut: 236; + nextPut: extendedIndex! Item was added: + ----- Method: EncoderForSistaV1>>genUnsignedMultipleExtendA: (in category 'bytecode generation') ----- + genUnsignedMultipleExtendA: extendedIndex + "224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A)" + extendedIndex > 255 ifTrue: + [self genUnsignedMultipleExtendA: extendedIndex // 256]. + stream + nextPut: 224; + nextPut: extendedIndex \\ 256! Item was added: + ----- Method: EncoderForSistaV1>>genUnsignedSingleExtendA: (in category 'bytecode generation') ----- + genUnsignedSingleExtendA: extendedIndex + (extendedIndex between: 0 and: 255) ifFalse: + [^self outOfRangeError: 'index' index: extendedIndex range: 0 to: 255]. + "224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A) + ExtA is normally unsigned." + stream + nextPut: 224; + nextPut: extendedIndex! Item was added: + ----- Method: EncoderForSistaV1>>genUnsignedSingleExtendB: (in category 'bytecode generation') ----- + genUnsignedSingleExtendB: extendedIndex + (extendedIndex between: 0 and: 255) ifFalse: + [^self outOfRangeError: 'index' index: extendedIndex range: 0 to: 255]. + "225 11100001 sbbbbbbb Extend B (Ext B = Ext B prev * 256 + Ext B). + ExtB is normally signed" + stream + nextPut: 225; + nextPut: extendedIndex! Item was added: + ----- Method: EncoderForSistaV1>>isSpecialLiteralForPush: (in category 'special literal encodings') ----- + isSpecialLiteralForPush: literal + ^literal isInteger + ifFalse: + [literal isCharacter + ifFalse: + [false == literal + or: [true == literal + or: [nil == literal]]] + ifTrue: + [Smalltalk interpreterVMMakerVersion >= 3174 + ifTrue: + [literal asInteger between: 0 and: 65535] + ifFalse: + ["Restrict character range due to VM bug at character value reconstruction + See https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/618" + literal asInteger between: 0 and: 16rFF]]] + ifTrue: + [literal between: -32768 and: 32767]! Item was added: + ----- Method: EncoderForSistaV1>>isSpecialLiteralForReturn: (in category 'special literal encodings') ----- + isSpecialLiteralForReturn: literal + ^literal == false + or: [literal == true + or: [literal == nil]]! Item was added: + ----- Method: EncoderForSistaV1>>maxIndexableLiterals (in category 'accessing') ----- + maxIndexableLiterals + "Answer the maximum number of literals supported by the receiver's + bytecode set." + ^65536! Item was added: + ----- Method: EncoderForSistaV1>>supportsFullBlocks (in category 'testing') ----- + supportsFullBlocks + "Answer if the instruction set supports full closures (closure creation from + specfic methods instead of bytecodes embedded in an outer home method)." + + ^true! Item was added: + BytecodeEncoder subclass: #EncoderForV3 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !EncoderForV3 commentStamp: 'eem 1/18/2019 12:38' prior: 0! + I add behaviour to Encoder to size and emit bytecodes for the Squeak V3.x VM bytecode set, a close variant of the original Smalltalk-80 bytecode set defined in the Blue Book. + + 0-15 0000iiii Push Receiver Variable #iiii + 16-31 0001iiii Push Temporary Location #iiii + 32-63 001iiiii Push Literal Constant #iiiii + 64-95 010iiiii Push Literal Variable #iiiii + 96-103 01100iii Pop and Store Receiver Variable #iii + 104-111 01101iii Pop and Store Temporary Location #iii + 112-119 01110iii Push (receiver, true, false, nil, -1, 0, 1, 2) [iii] + 120-123 011110ii Return (receiver, true, false, nil) [ii] From Message + 124-125 0111110i Return Stack Top From (Message, Block) [i] + (126-127 unassigned) + 128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk + 129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk + 130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk + 131 10000011 jjjkkkkk Send Literal Selector #kkkkk With jjj Arguments + 132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs) + 133 10000101 jjjkkkkk Send Literal Selector #kkkkk To Superclass With jjj Arguments + 134 10000110 jjkkkkkk Send Literal Selector #kkkkkk With jj Arguments + 135 10000111 Pop Stack Top + 136 10001000 Duplicate Stack Top + 137 10001001 Push Active Context + (138-143 unassigned) + 144-151 10010iii Jump iii + 1 (i.e., 1 through 8) + 152-159 10011iii Pop and Jump 0n False iii +1 (i.e., 1 through 8) + 160-167 10100iii jjjjjjjj Jump(iii - 4) *256+jjjjjjjj + 168-171 101010ii jjjjjjjj Pop and Jump On True ii *256+jjjjjjjj + 172-175 101011ii jjjjjjjj Pop and Jump On False ii *256+jjjjjjjj + 176-191 1011iiii Send Arithmetic Message #iiii + 192-207 1100iiii Send Special Message #iiii + 208-223 1101iiii Send Literal Selector #iiii With No Arguments + 224-239 1110iiii Send Literal Selector #iiii With 1 Argument + 240-255 1111iiii Send Literal Selector #iiii With 2 Arguments + ! Item was added: + ----- Method: EncoderForV3 class>>bindingReadScanBlockFor:using: (in category 'compiled method support') ----- + bindingReadScanBlockFor: bindingLitIndex using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for reads of the value of the binding with zero-relative index litVarIndex. + N.B. Don't assume the compiler uses the most compact encoding available." + ^[:b| + b >= 64 + and: [b <= 95 + ifTrue: [b - 64 = bindingLitIndex] + ifFalse: + [b = 128 + ifTrue: [scanner followingByte - 192 = bindingLitIndex] + ifFalse: + [b = 132 + and: [(scanner followingByte between: 128 and: 159) + and: [scanner thirdByte = bindingLitIndex]]]]]]! Item was added: + ----- Method: EncoderForV3 class>>bindingWriteScanBlockFor:using: (in category 'compiled method support') ----- + bindingWriteScanBlockFor: bindingLitIndex using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for writes of the value of the binding with zero-relative index bindingLitIndex. + N.B. Don't assume the compiler uses the most compact encoding available." + ^[:b| + (b = 129 or: [b = 130]) + ifTrue: [scanner followingByte - 192 = bindingLitIndex] + ifFalse: + [b = 132 + and: [scanner followingByte >= 224 + and: [scanner thirdByte = bindingLitIndex]]]]! Item was added: + ----- Method: EncoderForV3 class>>bytecodeSize: (in category 'instruction stream support') ----- + bytecodeSize: bytecode + "Answer the number of bytes in the bytecode." + bytecode <= 125 ifTrue: + [^1]. + bytecode >= 176 ifTrue: + [^1]. + bytecode >= 160 ifTrue: "long jumps" + [^2]. + bytecode >= 144 ifTrue: "short jumps" + [^1]. + "extensions" + bytecode >= 128 ifTrue: + [^#(2 2 2 2 3 2 2 1 1 1 nil nil nil nil nil nil) at: bytecode - 127]. + ^nil! Item was added: + ----- Method: EncoderForV3 class>>canBeSpecialLiteral: (in category 'testing') ----- + canBeSpecialLiteral: aLiteral + "This check can be used to prevent unnecessary use of #scanBlockOrNilForLiteral:." + + aLiteral isVariableBinding ifTrue: [^false]. "a common case; don't waste time analysing..." + + aLiteral isSymbol ifTrue: [^ Smalltalk specialSelectors identityIncludes: aLiteral]. + aLiteral isInteger ifTrue: [^ aLiteral between: -1 and: 2]. + + aLiteral == true ifTrue: [^ true]. + aLiteral == false ifTrue: [^ true]. + aLiteral == nil ifTrue: [^ true]. + + ^ false! Item was added: + ----- Method: EncoderForV3 class>>createClosureScanBlock (in category 'compiled method support') ----- + createClosureScanBlock + "Answer a block argument for InstructionStream>>scanFor: that answers true + for block closure creation bytecodes." + ^[:b| false]! Item was added: + ----- Method: EncoderForV3 class>>extensionsAt:in:into: (in category 'instruction stream support') ----- + extensionsAt: pc in: aCompiledMethod into: trinaryBlock + "If the bytecode at pc is an extension then evaluate aTrinaryBlock + with the values of extA and extB and number of extension *bytes*. + If the bytecode at pc is not an extension then evaluate with 0, 0, 0. + There are no extensions in the SqueakV3/Smalltalk-80 bytecode set, so..." + ^trinaryBlock value: 0 value: 0 value: 0! Item was added: + ----- Method: EncoderForV3 class>>extensionsFor:in:into: (in category 'instruction stream support') ----- + extensionsFor: pc in: aCompiledMethod into: trinaryBlock + "If the bytecode at pc is an extension, or if the bytecode at pc is preceded by extensions, + then evaluate aTrinaryBlock with the values of extA and extB and number of extension *bytes*. + If the bytecode at pc is neither an extension or extended then evaluate with 0, 0, 0. + There are no extensions in the SqueakV3/Smalltalk-80 bytecode set, so..." + ^trinaryBlock value: 0 value: 0 value: 0! Item was added: + ----- Method: EncoderForV3 class>>instVarReadScanBlockFor:using: (in category 'compiled method support') ----- + instVarReadScanBlockFor: varIndexCode using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for reads of the inst var with zero-relative index varIndexCode. + N.B. Don't assume the compiler uses the most compact encoding available." + ^[:b| + b < 16 + ifTrue: [b = varIndexCode] + ifFalse: + [b = 128 + ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]] + ifFalse: + [b = 132 + and: [(scanner followingByte between: 64 and: 95) + and: [scanner thirdByte = varIndexCode]]]]]! Item was added: + ----- Method: EncoderForV3 class>>instVarWriteScanBlockFor:using: (in category 'compiled method support') ----- + instVarWriteScanBlockFor: varIndexCode using: scanner + "Answer a block argument for InstructionStream>>scanFor: that answers true + for writes of the inst var with zero-relative index varIndexCode. + N.B. Don't assume the compiler uses the most compact encoding available." + ^[:b| + b >= 96 + and: [b <= 103 + ifTrue: [b - 96 = varIndexCode] + ifFalse: + [(b = 129 or: [b = 130]) + ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]] + ifFalse: + [b = 132 + and: [(scanner followingByte between: 160 and: 223) + and: [scanner thirdByte = varIndexCode]]]]]]! Item was added: + ----- Method: EncoderForV3 class>>interpretJumpIfCondIn: (in category 'instruction stream support') ----- + interpretJumpIfCondIn: anInstructionStream + "Double-dispatch through the encoder to select the correct conditional jump decoder for the instruction set." + ^anInstructionStream interpretV3JumpIfCond! Item was added: + ----- Method: EncoderForV3 class>>interpretJumpIn: (in category 'instruction stream support') ----- + interpretJumpIn: anInstructionStream + "Double-dispatch through the encoder to select the correct jump interpreter for the instruction set." + ^anInstructionStream interpretV3Jump! Item was added: + ----- Method: EncoderForV3 class>>interpretNextInstructionFor:in: (in category 'instruction stream support') ----- + interpretNextInstructionFor: aClient in: anInstructionStream + "Double-dispatch through the encoder to select the correct instruction set decoder." + ^anInstructionStream interpretNextV3InstructionFor: aClient! Item was added: + ----- Method: EncoderForV3 class>>isBlockReturnAt:in: (in category 'instruction stream support') ----- + isBlockReturnAt: pc in: method + "Answer whether the bytecode at pc is a return from block." + + ^(method at: pc) = 125! Item was added: + ----- Method: EncoderForV3 class>>isBranchIfFalseAt:in: (in category 'instruction stream support') ----- + isBranchIfFalseAt: pc in: method + "Answer whether the bytecode at pc is a conditional branch-if-false." + | bytecode | + bytecode := method at: pc. + ^(bytecode between: 152 and: 159) or: [bytecode between: 172 and: 175]! Item was added: + ----- Method: EncoderForV3 class>>isBranchIfTrueAt:in: (in category 'instruction stream support') ----- + isBranchIfTrueAt: pc in: method + "Answer whether the bytecode at pc is a conditional branch-if-true." + ^(method at: pc) between: 168 and: 171! Item was added: + ----- Method: EncoderForV3 class>>isExtension: (in category 'instruction stream support') ----- + isExtension: bytecode + "Answer if the bytecode is an extension bytecode, i.e. one that extends the + range of the following bytecode. The Smalltalk-80/V3 sets don't use extensions." + ^false! Item was added: + ----- Method: EncoderForV3 class>>isJumpAt:in: (in category 'instruction stream support') ----- + isJumpAt: pc in: method + "Answer whether the bytecode at pc is an (unconditional) jump." + | bytecode | + bytecode := method at: pc. + ^(bytecode between: 144 and: 151) or: [bytecode between: 160 and: 167]! Item was added: + ----- Method: EncoderForV3 class>>isJustPopAt:in: (in category 'instruction stream support') ----- + isJustPopAt: pc in: method + "Answer whether the bytecode at pc is a pop." + + ^(method at: pc) = 135 "135 10000111 Pop Stack Top"! Item was added: + ----- Method: EncoderForV3 class>>isRealSendAt:in: (in category 'instruction stream support') ----- + isRealSendAt: pc in: method + "Answer whether the bytecode at pc is a real message-send, not blockCopy:." + + | byte | + byte := method at: pc. + ^byte >= 176 "special send or short send" + or: [byte >= 131 + and: [byte <= 134 "long sends" + and: [byte ~= 132 "double extended do anything" + or: [(method at: pc + 1) // 32 <= 1]]]]! Item was added: + ----- Method: EncoderForV3 class>>isReturnAt:in: (in category 'instruction stream support') ----- + isReturnAt: pc in: method + "Answer whether the bytecode at pc is a return." + + ^(method at: pc) between: 120 and: 125! Item was added: + ----- Method: EncoderForV3 class>>isReturnSelfFromMethodAt:in: (in category 'instruction stream support') ----- + isReturnSelfFromMethodAt: pc in: method + "Answer whether the bytecode at pc is a return self from method." + + ^(method at: pc) = 120! Item was added: + ----- Method: EncoderForV3 class>>isReturnTopFromMethodAt:in: (in category 'instruction stream support') ----- + isReturnTopFromMethodAt: pc in: method + "Answer whether the bytecode at pc is a return stack top from method." + + ^(method at: pc) = 124! Item was added: + ----- Method: EncoderForV3 class>>isSendAt:in: (in category 'instruction stream support') ----- + isSendAt: pc in: method + "Answer whether the bytecode at pc is a message-send." + + | byte | + byte := method at: pc. + ^byte >= 176 "special send or short send" + or: [byte >= 131 + and: [byte <= 134 "long sends" + and: [byte ~= 132 "double extended do anything" + or: [(method at: pc + 1) // 32 <= 1]]]]! Item was added: + ----- Method: EncoderForV3 class>>isStoreAt:in: (in category 'instruction stream support') ----- + isStoreAt: pc in: method + "Answer whether the bytecode at pc is a store or store-pop." + + | byte | + byte := method at: pc. + ^(byte between: 96 and: 132) + and: [byte <= 111 "96 103 storeAndPopReceiverVariableBytecode" + "104 111 storeAndPopTemporaryVariableBytecode" + or: [byte >= 129 "129 extendedStoreBytecode" + and: [byte <= 130 "130 extendedStoreAndPopBytecode" + or: [byte = 132 "132 doubleExtendedDoAnythingBytecode" + and: [(method at: pc+1) >= 160]]]]]! Item was added: + ----- Method: EncoderForV3 class>>isStorePopAt:in: (in category 'instruction stream support') ----- + isStorePopAt: pc in: method + "Answer whether the bytecode at pc is a store-pop." + + | byte | + byte := method at: pc. + ^(byte between: 96 and: 111) "96 103 storeAndPopReceiverVariableBytecode" + "104 111 storeAndPopTemporaryVariableBytecode" + or: [byte = 130] "130 extendedStoreAndPopBytecode"! Item was added: + ----- Method: EncoderForV3 class>>isSyntheticStoreAt:in:for: (in category 'instruction stream support') ----- + isSyntheticStoreAt: pc in: method for: anInstructionStream + "Answer whether the bytecode at pc is a store or store-pop of an indirect temp vector, + which implement mutable closed-over variables in the the closure implementation. + Stores into temp vectors are not real stores." + + ^false! Item was added: + ----- Method: EncoderForV3 class>>isTempStoreAt:in: (in category 'instruction stream support') ----- + isTempStoreAt: pc in: method + "Answer whether the bytecode at pc is a store or store-pop into a temporary variable. + 104-111 01101iii Pop and Store Temporary Location #iii + 129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk + 130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" + + | byte | + byte := method at: pc. + ^byte >= 104 + and: [byte <= 111 + or: [byte <= 130 and: [byte >= 129 and: [(method at: pc + 1) >> 6 = 1]]]]! Item was added: + ----- Method: EncoderForV3 class>>markerOrNilFor: (in category 'compiled method support') ----- + markerOrNilFor: aMethod + "If aMethod is a marker method, answer the symbol used to mark it. Otherwise + answer nil. What is a marker method? It is method with body like + 'self subclassResponsibility' or '^ self subclassResponsibility' + used to indicate ('mark') a special property. + + Marker methods compile to two bytecode forms, this: + self + send: <literal 1> + pop + returnSelf + or this: + self + send: <literal 1> + returnTop" + | expectedHeaderPlusLliteralSize e byte | + expectedHeaderPlusLliteralSize := Smalltalk wordSize * 4. + ^(((e := aMethod endPC - expectedHeaderPlusLliteralSize) = 3 or: [e = 4]) + and: [aMethod numLiterals = 3 + and: [(aMethod at: expectedHeaderPlusLliteralSize + 1) = 16r70 "push self" + and: [(aMethod at: expectedHeaderPlusLliteralSize + 2) = 16rD0 "send" + and: [(byte := aMethod at: expectedHeaderPlusLliteralSize + 3) = 16r87 "pop" or: [byte = 16r7C "returnTop"]]]]]) + ifTrue: [aMethod literalAt: 1]! Item was added: + ----- Method: EncoderForV3 class>>method:readsField: (in category 'scanning') ----- + method: method readsField: varIndex + "Answer if method loads the instance variable indexed by varIndex. + N.B. Don't assume the compiler uses the most compact encoding available. + 0-15 0000iiii Push Receiver Variable #iiii + 128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk + 132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)" + | varIndexCode scanner | + varIndexCode := varIndex - 1. + method isReturnField ifTrue: + [^method returnField = varIndexCode]. + ^(scanner := InstructionStream on: method) scanFor: + [:b| + b < 16 + ifTrue: [b = varIndexCode] + ifFalse: + [b = 128 + ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]] + ifFalse: + [b = 132 + and: [(scanner followingByte between: 64 and: 95) + and: [scanner thirdByte = varIndexCode]]]]]! Item was added: + ----- Method: EncoderForV3 class>>method:writesField: (in category 'scanning') ----- + method: method writesField: varIndex + "Answer if method stores into the instance variable indexed by varIndex. + N.B. Don't assume the compiler uses the most compact encoding available. + 96-103 01100iii Pop and Store Receiver Variable #iii + 129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk + 130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk + 132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)" + | varIndexCode scanner | + method isQuick ifTrue: [^false]. + varIndexCode := varIndex - 1. + ^(scanner := InstructionStream on: method) scanFor: + [:b| + b >= 96 + and: [b <= 103 + ifTrue: [b - 96 = varIndexCode] + ifFalse: + [(b = 129 or: [b = 130]) + ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]] + ifFalse: + [b = 132 + and: [(scanner followingByte between: 160 and: 223) + and: [scanner thirdByte = varIndexCode]]]]]]! Item was added: + ----- Method: EncoderForV3 class>>nonExtensionBytecodeAt:in: (in category 'instruction stream support') ----- + nonExtensionBytecodeAt: pc in: method + "Answer the actual bytecode at pc in method, skipping past any preceding extensions." + ^method at: pc! Item was added: + ----- Method: EncoderForV3 class>>pushNilCode (in category 'bytecode decoding') ----- + pushNilCode + "Answer the pushNil bytecode. + 112-119 01110iii Push (receiver, true, false, nil, -1, 0, 1, 2) [iii]" + ^115! Item was added: + ----- Method: EncoderForV3 class>>scanBlockOrNilForLiteral: (in category 'scanning') ----- + scanBlockOrNilForLiteral: aLiteral + "Answer a block argument for CompiledMethod>>#scanFor: that answers + if the method refers to the literal implicitly via a special bytecode. + If the literal is not accessible via a special bytecode, answer nil." + | value | + "176-191 1011iiii Send Arithmetic Message #iiii + 192-207 1100iiii Send Special Message #iiii" + (aLiteral isSymbol or: [aLiteral isInteger]) ifTrue: + [value := aLiteral isSymbol + ifTrue: [176 + ((Smalltalk specialSelectors indexOf: aLiteral ifAbsent: [^nil]) // 2)] + ifFalse: [(aLiteral between: -1 and: 2) ifFalse: [^nil]. + aLiteral + 117]. + ^[:byte| byte = value]]. + "112-119 01110iii Push (receiver, true, false, nil, -1, 0, 1, 2) [iii] + 120-123 011110ii Return (receiver, true, false, nil) [ii] From Message" + aLiteral == true ifTrue: + [^[:byte| byte = 113 or: [byte = 121]]]. + aLiteral == false ifTrue: + [^[:byte| byte = 114 or: [byte = 122]]]. + aLiteral == nil ifTrue: + [^[:byte| byte = 115 or: [byte = 123]]]. + ^nil! Item was added: + ----- Method: EncoderForV3 class>>selectorToSendOrItselfFor:in:at: (in category 'instruction stream support') ----- + selectorToSendOrItselfFor: anInstructionStream in: method at: pc + "If anInstructionStream is at a send bytecode then answer the send's selector, + otherwise answer anInstructionStream itself. The rationale for answering + anInstructionStream instead of, say, nil, is that potentially any existing object + can be used as a selector, but since anInstructionStream postdates the method, + it can't be one of them." + + | byte byte2 | + byte := method at: pc. + byte < 131 ifTrue: [^anInstructionStream]. + byte >= 176 + ifTrue: + ["special byte or short send" + byte >= 208 + ifTrue: [^method literalAt: (byte bitAnd: 15) + 1] + ifFalse: [^Smalltalk specialSelectorAt: byte - 176 + 1]] + ifFalse: + [byte <= 134 ifTrue: + [byte2 := method at: pc + 1. + byte = 131 ifTrue: [^method literalAt: byte2 \\ 32 + 1]. + byte = 132 ifTrue: [byte2 < 64 ifTrue: [^method literalAt: (method at: pc + 2) + 1]]. + byte = 133 ifTrue: [^method literalAt: byte2 \\ 32 + 1]. + byte = 134 ifTrue: [^method literalAt: byte2 \\ 64 + 1]]]. + ^anInstructionStream! Item was added: + ----- Method: EncoderForV3 class>>superSendScanBlockUsing: (in category 'compiled method support') ----- + superSendScanBlockUsing: scanner + "Answer a block argument for InstructionStream>>scanFor: + that answers true for super sends." + ^[:instr | + instr = 16r85 + or: [instr = 16r84 + and: [scanner followingByte between: 16r20 and: 16r3F]]]! Item was added: + ----- Method: EncoderForV3 class>>supportsClosures (in category 'compiled method support') ----- + supportsClosures + "Answer if the instruction set supports closures (contains + closure creation and indirect temp access bytecodes)." + + ^false! Item was added: + ----- Method: EncoderForV3 class>>unusedBytecode (in category 'bytecode decoding') ----- + unusedBytecode + "Answer the opcode of a single-byte unused bytecode, if it exists in the encoder's bytecode set, or nil if not." + ^126! Item was added: + ----- Method: EncoderForV3>>genBranchPopFalse: (in category 'bytecode generation') ----- + genBranchPopFalse: distance + "See BlueBook page 596" + distance < 0 ifTrue: + [^self outOfRangeError: 'distance' index: distance range: 0 to: 1023]. + (distance > 0 and: [distance < 9]) ifTrue: + ["152-159 10011iii Pop and Jump 0n False iii +1 (i.e., 1 through 8)" + stream nextPut: 152 + distance - 1. + ^self]. + distance < 1024 ifTrue: + ["172-175 101011ii jjjjjjjj Pop and Jump On False ii *256+jjjjjjjj" + stream + nextPut: 172 + (distance bitShift: -8); + nextPut: distance + 1024 \\ 256. + ^self]. + ^self outOfRangeError: 'distance' index: distance range: 0 to: 1023! Item was added: + ----- Method: EncoderForV3>>genBranchPopTrue: (in category 'bytecode generation') ----- + genBranchPopTrue: distance + "See BlueBook page 596" + distance < 0 ifTrue: + [^self outOfRangeError: 'distance' index: distance range: 0 to: 1023]. + distance < 1024 ifTrue: + ["168-171 101010ii jjjjjjjj Pop and Jump On True ii *256+jjjjjjjj" + stream + nextPut: 168 + (distance bitShift: -8); + nextPut: distance + 1024 \\ 256. + ^self]. + ^self outOfRangeError: 'distance' index: distance range: 0 to: 1023! Item was added: + ----- Method: EncoderForV3>>genDup (in category 'bytecode generation') ----- + genDup + "See BlueBook page 596" + "136 10001000 Duplicate Stack Top" + stream nextPut: 136! Item was added: + ----- Method: EncoderForV3>>genJump: (in category 'bytecode generation') ----- + genJump: distance + "See BlueBook page 596" + (distance > 0 and: [distance < 9]) ifTrue: + ["144-151 10010iii Jump iii + 1 (i.e., 1 through 8)" + stream nextPut: 144 + distance - 1. + ^self]. + "160-167 10100iii jjjjjjjj Jump(iii - 4) *256+jjjjjjjj" + ^self genJumpLong: distance! Item was added: + ----- Method: EncoderForV3>>genJumpLong: (in category 'bytecode generation') ----- + genJumpLong: distance + "See BlueBook page 596" + (distance >= -1024 and: [distance < 1024]) ifTrue: + ["160-167 10100iii jjjjjjjj Jump(iii - 4) *256+jjjjjjjj" + stream + nextPut: 160 + (distance + 1024 bitShift: -8); + nextPut: distance + 1024 \\ 256. + ^self]. + ^self outOfRangeError: 'distance' index: distance range: -1024 to: 1023! Item was added: + ----- Method: EncoderForV3>>genPop (in category 'bytecode generation') ----- + genPop + "See BlueBook page 596" + "135 10000111 Pop Stack Top" + stream nextPut: 135! Item was added: + ----- Method: EncoderForV3>>genPushInstVar: (in category 'bytecode generation') ----- + genPushInstVar: instVarIndex + "See BlueBook page 596" + instVarIndex >= 0 ifTrue: + [instVarIndex < 16 ifTrue: + ["0-15 0000iiii Push Receiver Variable #iiii" + stream nextPut: 0 + instVarIndex. + ^self]. + instVarIndex < 64 ifTrue: + ["128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 128; + nextPut: instVarIndex. + ^self]]. + self genPushInstVarLong: instVarIndex! Item was added: + ----- Method: EncoderForV3>>genPushInstVarLong: (in category 'bytecode generation') ----- + genPushInstVarLong: instVarIndex + "See BlueBook page 596" + "See also MaybeContextInstanceVariableNode" + (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: + ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" + stream + nextPut: 132; + nextPut: 64; + nextPut: instVarIndex. + ^self]. + ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! Item was added: + ----- Method: EncoderForV3>>genPushLiteral: (in category 'bytecode generation') ----- + genPushLiteral: literalIndex + "See BlueBook page 596" + literalIndex < 0 ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255]. + literalIndex < 32 ifTrue: + ["32-63 001iiiii Push Literal Constant #iiiii" + stream nextPut: 32 + literalIndex. + ^self]. + literalIndex < 64 ifTrue: + ["128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 128; + nextPut: 128 + literalIndex. + ^self]. + literalIndex < 256 ifTrue: + ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" + stream + nextPut: 132; + nextPut: 96; + nextPut: literalIndex. + ^self]. + ^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! Item was added: + ----- Method: EncoderForV3>>genPushLiteralVar: (in category 'bytecode generation') ----- + genPushLiteralVar: literalIndex + "See BlueBook page 596" + literalIndex < 0 ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255]. + literalIndex < 32 ifTrue: + ["64-95 010iiiii Push Literal Variable #iiiii" + stream nextPut: 64 + literalIndex. + ^self]. + literalIndex < 64 ifTrue: + ["128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 128; + nextPut: 192 + literalIndex. + ^self]. + literalIndex < 256 ifTrue: + ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" + stream + nextPut: 132; + nextPut: 128; + nextPut: literalIndex. + ^self]. + ^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! Item was added: + ----- Method: EncoderForV3>>genPushReceiver (in category 'bytecode generation') ----- + genPushReceiver + "See BlueBook page 596" + "112-119 01110iii Push (receiver, true, false, nil, -1, 0, 1, 2) [iii]" + stream nextPut: 112! Item was added: + ----- Method: EncoderForV3>>genPushSpecialLiteral: (in category 'bytecode generation') ----- + genPushSpecialLiteral: aLiteral + "112-119 01110iii Push (receiver, true, false, nil, -1, 0, 1, 2) [iii]" + | index | + index := #(true false nil -1 0 1 2) indexOf: aLiteral. + index = 0 ifTrue: + [^self error: 'push special literal: ', aLiteral printString, ' is not one of true false nil -1 0 1 2']. + stream nextPut: index + 112! Item was added: + ----- Method: EncoderForV3>>genPushTemp: (in category 'bytecode generation') ----- + genPushTemp: tempIndex + "See BlueBook page 596" + tempIndex < 0 ifTrue: + [^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63]. + tempIndex < 16 ifTrue: + ["16-31 0001iiii Push Temporary Location #iiii" + stream nextPut: 16 + tempIndex. + ^self]. + tempIndex < 64 ifTrue: + ["128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 128; + nextPut: 64 + tempIndex. + ^self]. + ^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! Item was added: + ----- Method: EncoderForV3>>genPushTempLong: (in category 'bytecode generation') ----- + genPushTempLong: tempIndex + "See BlueBook page 596" + (tempIndex >= 0 and: [tempIndex < 64]) ifTrue: + ["128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 128; + nextPut: 64 + tempIndex. + ^self]. + ^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! Item was added: + ----- Method: EncoderForV3>>genPushThisContext (in category 'bytecode generation') ----- + genPushThisContext + "See BlueBook page 596" + "137 10001001 Push Active Context" + stream nextPut: 137! Item was added: + ----- Method: EncoderForV3>>genReturnReceiver (in category 'bytecode generation') ----- + genReturnReceiver + "See BlueBook page 596" + "120-123 011110ii Return (receiver, true, false, nil) [ii] From Message" + stream nextPut: 120! Item was added: + ----- Method: EncoderForV3>>genReturnSpecialLiteral: (in category 'bytecode generation') ----- + genReturnSpecialLiteral: aLiteral + "120-123 011110ii Return (receiver, true, false, nil) [ii] From Message" + | index | + index := #(true false nil) indexOf: aLiteral. + index = 0 ifTrue: + [^self error: 'return special literal: ', aLiteral printString, ' is not one of true false nil']. + stream nextPut: 120 + index! Item was added: + ----- Method: EncoderForV3>>genReturnTop (in category 'bytecode generation') ----- + genReturnTop + "See BlueBook page 596" + "124-125 0111110i Return Stack Top From (Message, Block) [i]" + stream nextPut: 124! Item was added: + ----- Method: EncoderForV3>>genReturnTopToCaller (in category 'bytecode generation') ----- + genReturnTopToCaller + "See BlueBook page 596" + "124-125 0111110i Return Stack Top From (Message, Block) [i]" + stream nextPut: 125! Item was added: + ----- Method: EncoderForV3>>genSend:numArgs: (in category 'bytecode generation') ----- + genSend: selectorLiteralIndex numArgs: nArgs + "See BlueBook page 596 (with exceptions for 132 & 134)" + nArgs < 0 ifTrue: + [^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"]. + selectorLiteralIndex < 0 ifTrue: + ["Special selector sends. + 176-191 1011iiii Send Arithmetic Message #iiii + 192-207 1100iiii Send Special Message #iiii" + self flag: #yuck. + (selectorLiteralIndex negated between: 176 and: 207) ifFalse: + [^self outOfRangeError: 'special selector code' index: selectorLiteralIndex negated range: 176 to: 207]. + stream nextPut: selectorLiteralIndex negated. + ^self]. + (selectorLiteralIndex < 16 and: [nArgs < 3]) ifTrue: + [" 208-223 1101iiii Send Literal Selector #iiii With No Arguments + 224-239 1110iiii Send Literal Selector #iiii With 1 Argument + 240-255 1111iiii Send Literal Selector #iiii With 2 Arguments" + stream nextPut: 208 + (nArgs * 16) + selectorLiteralIndex. + ^self]. + (selectorLiteralIndex < 32 and: [nArgs < 8]) ifTrue: + [" 131 10000011 jjjkkkkk Send Literal Selector #kkkkk With jjj Arguments" + stream + nextPut: 131; + nextPut: ((nArgs bitShift: 5) + selectorLiteralIndex). + ^self]. + (selectorLiteralIndex < 64 and: [nArgs < 4]) ifTrue: + ["In Squeak V3 + 134 10000110 jjjjjjjj kkkkkkkk Send Literal Selector #kkkkkkkk To Superclass With jjjjjjjj Arguments + is replaced by + 134 10000110 jjkkkkkk Send Literal Selector #kkkkkk With jj Arguments" + stream + nextPut: 134; + nextPut: ((nArgs bitShift: 6) + selectorLiteralIndex). + ^self]. + (selectorLiteralIndex < 256 and: [nArgs < 32]) ifTrue: + ["In Squeak V3 + 132 10000100 jjjjjjjj kkkkkkkk Send Literal Selector #kkkkkkkk With jjjjjjjj Arguments + is replaced by + 132 10000100 ooojjjjj kkkkkkkk + ooo = 0 => Send Literal Selector #kkkkkkkk With jjjjj Arguments + ooo = 1 => Send Literal Selector #kkkkkkkk To Superclass With jjjjj Arguments" + stream + nextPut: 132; + nextPut: nArgs; + nextPut: selectorLiteralIndex. + ^self]. + nArgs >= 32 ifTrue: + [^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31]. + selectorLiteralIndex >= 256 ifTrue: + [^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255]! Item was added: + ----- Method: EncoderForV3>>genSendSpecial:numArgs: (in category 'bytecode generation') ----- + genSendSpecial: specialSelectorIndex numArgs: nArgs + "See BlueBook page 596" + self assert: (specialSelectorIndex between: 1 and: Smalltalk specialSelectorSize). + self assert: nArgs = (Smalltalk specialNargsAt: specialSelectorIndex). + "Special selector sends. + 176-191 1011iiii Send Arithmetic Message #iiii + 192-207 1100iiii Send Special Message #iiii" + stream nextPut: specialSelectorIndex + 175! Item was added: + ----- Method: EncoderForV3>>genSendSuper:numArgs: (in category 'bytecode generation') ----- + genSendSuper: selectorLiteralIndex numArgs: nArgs + "See BlueBook page 596 (with exceptions for 132 & 134)" + nArgs < 0 ifTrue: + [^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"]. + selectorLiteralIndex < 0 ifTrue: + [^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255]. + (selectorLiteralIndex < 32 and: [nArgs < 8]) ifTrue: + [" 133 10000011 jjjkkkkk Send Literal Selector #kkkkk To Superclass With jjj Arguments" + stream + nextPut: 133; + nextPut: ((nArgs bitShift: 5) + selectorLiteralIndex). + ^self]. + (selectorLiteralIndex < 256 and: [nArgs < 32]) ifTrue: + ["In Squeak V3 + 132 10000100 jjjjjjjj kkkkkkkk Send Literal Selector #kkkkkkkk With jjjjjjjj Arguments + is replaced by + 132 10000100 ooojjjjj kkkkkkkk + ooo = 0 => Send Literal Selector #kkkkkkkk With jjjjj Arguments + ooo = 1 => Send Literal Selector #kkkkkkkk To Superclass With jjjjj Arguments" + stream + nextPut: 132; + nextPut: 32 + nArgs; + nextPut: selectorLiteralIndex. + ^self]. + nArgs >= 32 ifTrue: + [^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31]. + selectorLiteralIndex >= 256 ifTrue: + [^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255]! Item was added: + ----- Method: EncoderForV3>>genStoreInstVar: (in category 'bytecode generation') ----- + genStoreInstVar: instVarIndex + "See BlueBook page 596" + (instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue: + ["129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 129; + nextPut: instVarIndex. + ^self]. + self genStoreInstVarLong: instVarIndex! Item was added: + ----- Method: EncoderForV3>>genStoreInstVarLong: (in category 'bytecode generation') ----- + genStoreInstVarLong: instVarIndex + "See BlueBook page 596" + "See also MaybeContextInstanceVariableNode" + (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: + ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" + stream + nextPut: 132; + nextPut: 160; + nextPut: instVarIndex. + ^self]. + ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! Item was added: + ----- Method: EncoderForV3>>genStoreLiteralVar: (in category 'bytecode generation') ----- + genStoreLiteralVar: literalIndex + "See BlueBook page 596" + literalIndex < 0 ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255]. + literalIndex < 64 ifTrue: + ["129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 129; + nextPut: 192 + literalIndex. + ^self]. + literalIndex < 256 ifTrue: + ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" + stream + nextPut: 132; + nextPut: 224; + nextPut: literalIndex. + ^self]. + ^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! Item was added: + ----- Method: EncoderForV3>>genStorePopInstVar: (in category 'bytecode generation') ----- + genStorePopInstVar: instVarIndex + "See BlueBook page 596" + instVarIndex >= 0 ifTrue: + [instVarIndex < 8 ifTrue: + ["96-103 01100iii Pop and Store Receiver Variable #iii" + stream nextPut: 96 + instVarIndex. + ^self]. + instVarIndex < 64 ifTrue: + ["130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 130; + nextPut: instVarIndex. + ^self]]. + self genStorePopInstVarLong: instVarIndex! Item was added: + ----- Method: EncoderForV3>>genStorePopInstVarLong: (in category 'bytecode generation') ----- + genStorePopInstVarLong: instVarIndex + "See BlueBook page 596" + "See also MaybeContextInstanceVariableNode" + (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: + ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" + stream + nextPut: 132; + nextPut: 192; + nextPut: instVarIndex. + ^self]. + ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! Item was added: + ----- Method: EncoderForV3>>genStorePopLiteralVar: (in category 'bytecode generation') ----- + genStorePopLiteralVar: literalIndex + "See BlueBook page 596" + literalIndex < 0 ifTrue: + [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255]. + literalIndex < 64 ifTrue: + ["130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 130; + nextPut: 192 + literalIndex. + ^self]. + literalIndex < 256 ifTrue: + ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" + stream + nextPut: 132; + nextPut: 224; + nextPut: literalIndex. + self genPop. + ^self]. + ^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! Item was added: + ----- Method: EncoderForV3>>genStorePopTemp: (in category 'bytecode generation') ----- + genStorePopTemp: tempIndex + "See BlueBook page 596" + tempIndex < 0 ifTrue: + [^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63]. + tempIndex < 8 ifTrue: + ["104-111 01101iii Pop and Store Temporary Location #iii" + stream nextPut: 104 + tempIndex. + ^self]. + tempIndex < 64 ifTrue: + ["130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 130; + nextPut: 64 + tempIndex. + ^self]. + ^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! Item was added: + ----- Method: EncoderForV3>>genStoreTemp: (in category 'bytecode generation') ----- + genStoreTemp: tempIndex + "See BlueBook page 596" + tempIndex < 0 ifTrue: + [^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63]. + tempIndex < 64 ifTrue: + ["129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" + stream + nextPut: 129; + nextPut: 64 + tempIndex. + ^self]. + ^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! Item was added: + ----- Method: EncoderForV3>>if:isSpecialLiteralForPush: (in category 'special literal encodings') ----- + if: code isSpecialLiteralForPush: aBlock + "If code is that of a special literal for push then evaluate aBlock with the special literal + The special literals for push are nil true false -1 0 1 & 2 which have special encodings + in the blue book bytecode set. Answer whether it was a special literal." + ^(code between: LdTrue and: LdNil + 4) + and: [aBlock value: (#(true false nil -1 0 1 2) at: code - LdSelf). + true]! Item was added: + ----- Method: EncoderForV3>>if:isSpecialLiteralForReturn: (in category 'special literal encodings') ----- + if: code isSpecialLiteralForReturn: aBlock + "If code is that of a special literal for return then evaluate aBlock with the special literal. + The special literals for return are nil true false which have special encodings + in the blue book bytecode set. Answer whether it was a special literal." + ^(code between: LdTrue and: LdNil) + and: [aBlock value: (#(true false nil) at: code - LdSelf). + true]! Item was added: + ----- Method: EncoderForV3>>isSpecialLiteralForPush: (in category 'special literal encodings') ----- + isSpecialLiteralForPush: literal + ^literal isInteger + ifFalse: + [false == literal + or: [true == literal + or: [nil == literal]]] + ifTrue: [literal between: -1 and: 2]! Item was added: + ----- Method: EncoderForV3>>isSpecialLiteralForReturn: (in category 'special literal encodings') ----- + isSpecialLiteralForReturn: literal + ^literal == false + or: [literal == true + or: [literal == nil]]! Item was added: + ----- Method: EncoderForV3>>maxIndexableLiterals (in category 'bytecode generation') ----- + maxIndexableLiterals + "This bytecode set can index up to 256 literals." + ^256! Item was added: + ----- Method: EncoderForV3>>supportsFullBlocks (in category 'testing') ----- + supportsFullBlocks + "Answer if the instruction set supports full closures (closure creation from + specfic methods instead of bytecodes embedded in an outer home method)." + + ^false! Item was added: + EncoderForV3 subclass: #EncoderForV3PlusClosures + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !EncoderForV3PlusClosures commentStamp: 'eem 2/29/2016 00:07' prior: 0! + An encoder for the V3 bytecode set augmented with the following bytecodes that are part of the full closure implementation. + 138 10001010 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) + or Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1) + 139 10001011 kkkkkkkk jjjjjjjj Invoke primitive number jjjjjjjjkkkkkkkk + 140 10001100 kkkkkkkk jjjjjjjj Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj + 141 10001101 kkkkkkkk jjjjjjjj Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj + 142 10001110 kkkkkkkk jjjjjjjj Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj + 143 10001111 llllkkkk jjjjjjjj iiiiiiii Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii + This is an exact duplicate of EncoderForLongFormV3PlusClosures. + Could be a trait (or in Newspeak, a Mixin). + For now we impose upon you to synchronise any and all changes between these two classes.! Item was added: + ----- Method: EncoderForV3PlusClosures class>>bytecodeSize: (in category 'instruction stream support') ----- + bytecodeSize: bytecode + "Answer the number of bytes in the bytecode." + bytecode <= 125 ifTrue: + [^1]. + bytecode >= 176 ifTrue: + [^1]. + bytecode >= 160 ifTrue: "long jumps" + [^2]. + bytecode >= 144 ifTrue: "short jumps" + [^1]. + "extensions" + bytecode >= 128 ifTrue: + [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127]. + ^nil! Item was added: + ----- Method: EncoderForV3PlusClosures class>>callPrimitiveCode (in category 'bytecode decoding') ----- + callPrimitiveCode + "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" + ^139! Item was added: + ----- Method: EncoderForV3PlusClosures class>>createClosureCode (in category 'bytecode decoding') ----- + createClosureCode + "Answer the create closure bytecode, if it exists in the encoder's bytecode set, or nil if not. + Actually this code is that for a closure whose bytecodes are nested within its home method's." + ^143! Item was added: + ----- Method: EncoderForV3PlusClosures class>>createClosureScanBlock (in category 'compiled method support') ----- + createClosureScanBlock + "Answer a block argument for InstructionStream>>scanFor: that answers true + for block closure creation bytecodes." + ^[ :bc | bc = 143]! Item was added: + ----- Method: EncoderForV3PlusClosures class>>interpretNextInstructionFor:in: (in category 'instruction stream support') ----- + interpretNextInstructionFor: aClient in: anInstructionStream + "Double-dispatch through the encoder to select the correct instruction set decoder." + ^anInstructionStream interpretNextV3ClosuresInstructionFor: aClient! Item was added: + ----- Method: EncoderForV3PlusClosures class>>isStoreAt:in: (in category 'instruction stream support') ----- + isStoreAt: pc in: method + "Answer whether the bytecode at pc is a store or store-pop." + + | byte | + byte := method at: pc. + ^(byte between: 96 and: 142) + and: [byte <= 111 "96 103 storeAndPopReceiverVariableBytecode" + "104 111 storeAndPopTemporaryVariableBytecode" + or: [byte >= 129 "129 extendedStoreBytecode" + and: [byte <= 130 "130 extendedStoreAndPopBytecode" + or: [(byte = 132 "132 doubleExtendedDoAnythingBytecode" + and: [(method at: pc+1) >= 160]) + or: [byte = 141 "141 storeRemoteTempLongBytecode" + or: [byte = 142 "142 storeAndPopRemoteTempLongBytecode"]]]]]]! Item was added: + ----- Method: EncoderForV3PlusClosures class>>isStorePopAt:in: (in category 'instruction stream support') ----- + isStorePopAt: pc in: method + "Answer whether the bytecode at pc is a store-pop." + + | byte | + byte := method at: pc. + ^(byte between: 96 and: 111) "96 103 storeAndPopReceiverVariableBytecode" + "104 111 storeAndPopTemporaryVariableBytecode" + or: [byte = 130 "130 extendedStoreAndPopBytecode" + or: [byte = 142]] "142 storeAndPopRemoteTempLongBytecode"! Item was added: + ----- Method: EncoderForV3PlusClosures class>>isSyntheticStoreAt:in:for: (in category 'instruction stream support') ----- + isSyntheticStoreAt: pc in: method for: anInstructionStream + "Answer whether the bytecode at pc is a store or store-pop of an indirect temp vector, + which implement mutable closed-over variables in the the closure implementation. + Stores into temp vectors are not real stores. N.B. pcPreviousTo:in:for: is slow, so filter + out any preceding bytecodes other than what looks like a pushNewArrayCode. But the + pcPreviousTo:in:for: is still necessary, since the presence of a pcPreviousTo:in:for: in the + right place is potentially ambiguous, possibly part of a different bytecode seqence." + + ^(self isTempStoreAt: pc in: method) + and: [pc - 2 >= method initialPC + and: [(method at: pc - 2) = self pushNewArrayCode + and: [(method at: pc - 1) <= 127 + and: [pc - 2 = (self pcPreviousTo: pc in: method for: anInstructionStream)]]]]! Item was added: + ----- Method: EncoderForV3PlusClosures class>>pcFollowingBlockAt:in: (in category 'bytecode decoding') ----- + pcFollowingBlockAt: pc in: method + "Assuming the pc is that of a block creation bytecode, answer the pc immediately following the block, + i.e. the next pc after the block creation." + self assert: (method at: pc) = self createClosureCode. + ^(method at: pc + 2) * 256 + (method at: pc + 3) + pc + 4! Item was added: + ----- Method: EncoderForV3PlusClosures class>>pcOfBlockCreationBytecodeForBlockStartingAt:in: (in category 'bytecode decoding') ----- + pcOfBlockCreationBytecodeForBlockStartingAt: startpc in: method + "Answer the pc of the push closure bytecode whose block starts at startpc in method. + 143 10001111 llllkkkk jjjjjjjj iiiiiiii Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii" + ^startpc - 4! Item was added: + ----- Method: EncoderForV3PlusClosures class>>pushClosureBytecodeSize (in category 'bytecode decoding') ----- + pushClosureBytecodeSize + "Answer the size of the push closure bytecode. + 143 10001111 llllkkkk jjjjjjjj iiiiiiii Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii" + ^4! Item was added: + ----- Method: EncoderForV3PlusClosures class>>pushNewArrayCode (in category 'bytecode decoding') ----- + pushNewArrayCode + "138 10001010 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) + or Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)" + ^138! Item was added: + ----- Method: EncoderForV3PlusClosures class>>supportsClosures (in category 'compiled method support') ----- + supportsClosures + "Answer if the instruction set supports closures (contains + closure creation and indirect temp access bytecodes)." + + ^true! Item was added: + ----- Method: EncoderForV3PlusClosures>>genCallPrimitive: (in category 'bytecode generation') ----- + genCallPrimitive: primitiveIndex + "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" + (primitiveIndex < 1 or: [primitiveIndex > 65535]) ifTrue: + [self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 65535]. + stream + nextPut: 139; + nextPut: (primitiveIndex bitAnd: 255); + nextPut: (primitiveIndex bitShift: -8)! Item was added: + ----- Method: EncoderForV3PlusClosures>>genPushClosureCopyNumCopiedValues:numArgs:jumpSize: (in category 'bytecode generation') ----- + genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: jumpSize + "143 10001111 llllkkkk jjjjjjjj iiiiiiii Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii" + (jumpSize < 0 or: [jumpSize > 65535]) ifTrue: + [^self outOfRangeError: 'block size' index: jumpSize range: 0 to: 65535]. + (numCopied < 0 or: [numCopied > 15]) ifTrue: + [^self outOfRangeError: 'num copied' index: numCopied range: 0 to: 15]. + (numArgs < 0 or: [numArgs > 15]) ifTrue: + [^self outOfRangeError: 'num args' index: numArgs range: 0 to: 15]. + stream + nextPut: 143; + nextPut: numArgs + (numCopied bitShift: 4); + nextPut: (jumpSize bitShift: -8); + nextPut: (jumpSize bitAnd: 16rFF)! Item was added: + ----- Method: EncoderForV3PlusClosures>>genPushConsArray: (in category 'bytecode generation') ----- + genPushConsArray: size + (size < 0 or: [size > 127]) ifTrue: + [^self outOfRangeError: 'numElements' index: size range: 0 to: 127]. + "138 10001010 1kkkkkkk Push (Array new: kkkkkkk)" + stream + nextPut: 138; + nextPut: size + 128! Item was added: + ----- Method: EncoderForV3PlusClosures>>genPushNewArray: (in category 'bytecode generation') ----- + genPushNewArray: size + (size < 0 or: [size > 127]) ifTrue: + [^self outOfRangeError: 'numElements' index: size range: 0 to: 127]. + "138 10001010 0kkkkkkk Pop kkkkkkk into: (Array new: kkkkkkk)" + stream + nextPut: 138; + nextPut: size! Item was added: + ----- Method: EncoderForV3PlusClosures>>genPushRemoteTemp:inVectorAt: (in category 'bytecode generation') ----- + genPushRemoteTemp: tempIndex inVectorAt: tempVectorIndex + (tempIndex >= 0 and: [tempIndex < 256 + and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue: + ["140 10001100 kkkkkkkk jjjjjjjj Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj" + stream + nextPut: 140; + nextPut: tempIndex; + nextPut: tempVectorIndex. + ^self]. + tempIndex >= 256 ifTrue: + [^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255]. + tempVectorIndex >= 256 ifTrue: + [^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! Item was added: + ----- Method: EncoderForV3PlusClosures>>genStorePopRemoteTemp:inVectorAt: (in category 'bytecode generation') ----- + genStorePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex + "142 10001110 kkkkkkkk jjjjjjjj Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj" + (tempIndex >= 0 and: [tempIndex < 256 + and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue: + [stream + nextPut: 142; + nextPut: tempIndex; + nextPut: tempVectorIndex. + ^self]. + tempIndex >= 256 ifTrue: + [^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255]. + tempVectorIndex >= 256 ifTrue: + [^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! Item was added: + ----- Method: EncoderForV3PlusClosures>>genStoreRemoteTemp:inVectorAt: (in category 'bytecode generation') ----- + genStoreRemoteTemp: tempIndex inVectorAt: tempVectorIndex + "141 10001101 kkkkkkkk jjjjjjjj Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj" + (tempIndex >= 0 and: [tempIndex < 256 + and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue: + [stream + nextPut: 141; + nextPut: tempIndex; + nextPut: tempVectorIndex. + ^self]. + tempIndex >= 256 ifTrue: + [^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255]. + tempVectorIndex >= 256 ifTrue: + [^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! Item was added: + ----- Method: EncoderForV3PlusClosures>>supportsClosureOpcodes (in category 'testing') ----- + supportsClosureOpcodes + ^true! Item was added: + VariableNode subclass: #FieldNode + instanceVariableNames: 'fieldDef rcvrNode readNode writeNode' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !FieldNode commentStamp: 'eem 5/24/2017 10:26' prior: 0! + FieldNode handles field access in Tweak, e.g. self fieldName := foo => self fieldName: foo.! Item was added: + ----- Method: FieldNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitFieldNode: self! Item was added: + ----- Method: FieldNode>>assignmentCheck:at: (in category 'testing') ----- + assignmentCheck: encoder at: location + (encoder cantStoreInto: name) ifTrue: [^location]. + fieldDef toSet ifNil:[ + encoder interactive ifTrue:[^location]. + fieldDef := fieldDef shallowCopy assignDefaultSetter. + ]. + ^-1! Item was added: + ----- Method: FieldNode>>emitCodeForEffect:encoder: (in category 'code generation') ----- + emitCodeForEffect: stack encoder: encoder! Item was added: + ----- Method: FieldNode>>emitCodeForLoad:forValue:encoder: (in category 'code generation') ----- + emitCodeForLoad: stack forValue: forValue encoder: encoder + rcvrNode emitCodeForValue: stack encoder: encoder. + fieldDef accessKey ifNotNil: + [super emitCodeForValue: stack encoder: encoder]! Item was added: + ----- Method: FieldNode>>emitCodeForStore:encoder: (in category 'code generation') ----- + emitCodeForStore: stack encoder: encoder + fieldDef accessKey ifNil:[ + writeNode emitCode: stack args: 1 encoder: encoder super: false. + ] ifNotNil:[ + writeNode emitCode: stack args: 2 encoder: encoder super: false. + ].! Item was added: + ----- Method: FieldNode>>emitCodeForStorePop:encoder: (in category 'code generation') ----- + emitCodeForStorePop: stack encoder: encoder + self emitCodeForStore: stack encoder: encoder. + encoder genPop. + stack pop: 1.! Item was added: + ----- Method: FieldNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + fieldDef accessKey ifNil:[ + rcvrNode emitCodeForValue: stack encoder: encoder. + readNode emitCode: stack args: 0 encoder: encoder super: false. + ] ifNotNil:[ + rcvrNode emitCodeForValue: stack encoder: encoder. + super emitCodeForValue: stack encoder: encoder. + readNode emitCode: stack args: 1 encoder: encoder super: false. + ].! Item was added: + ----- Method: FieldNode>>encodeReceiverOn: (in category 'code generation') ----- + encodeReceiverOn: encoder + "encode the receiver node" + rcvrNode := encoder encodeVariable: 'self'.! Item was added: + ----- Method: FieldNode>>fieldDef (in category 'accessing') ----- + fieldDef + ^fieldDef! Item was added: + ----- Method: FieldNode>>fieldDefinition: (in category 'initialize-release') ----- + fieldDefinition: fieldDefinition + self name: fieldDefinition name key: fieldDefinition index: nil type: LdLitType! Item was added: + ----- Method: FieldNode>>name:key:index:type: (in category 'initialize-release') ----- + name: varName key: objRef index: i type: type + fieldDef := objRef. + ^super name: varName key: objRef key index: nil type: LdLitType! Item was added: + ----- Method: FieldNode>>resetFromCopy: (in category 'code generation') ----- + resetFromCopy: aFieldNode + "Reset the state of the recever to match that of the argument. + This is used to reset nodes that may have been repurposed + while generatig the compiled method for a full block." + + self assert: (fieldDef == aFieldNode fieldDef + and: [rcvrNode == (aFieldNode instVarNamed: 'rcvrNode') + and: [readNode == (aFieldNode instVarNamed: 'readNode') + and: [writeNode == (aFieldNode instVarNamed: 'writeNode')]]]). + super resetFromCopy: aFieldNode! Item was added: + ----- Method: FieldNode>>sizeCodeForEffect: (in category 'code generation') ----- + sizeCodeForEffect: encoder + ^0! Item was added: + ----- Method: FieldNode>>sizeCodeForStore: (in category 'code generation') ----- + sizeCodeForStore: encoder + rcvrNode ifNil:[self encodeReceiverOn: encoder]. + fieldDef accessKey ifNil:[ + writeNode ifNil:[writeNode := encoder encodeSelector: fieldDef toSet]. + ^(rcvrNode sizeCodeForValue: encoder) + + (writeNode sizeCode: encoder args: 1 super: false) + ]. + writeNode ifNil:[writeNode := encoder encodeSelector: #set:to:]. + ^(rcvrNode sizeCodeForValue: encoder) + + (super sizeCodeForValue: encoder) + + (writeNode sizeCode: encoder args: 2 super: false)! Item was added: + ----- Method: FieldNode>>sizeCodeForStorePop: (in category 'code generation') ----- + sizeCodeForStorePop: encoder + ^(self sizeCodeForStore: encoder) + encoder sizePop! Item was added: + ----- Method: FieldNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + rcvrNode ifNil:[self encodeReceiverOn: encoder]. + fieldDef accessKey ifNil:[ + readNode ifNil:[readNode := encoder encodeSelector: fieldDef toGet]. + ^(rcvrNode sizeCodeForValue: encoder) + + (readNode sizeCode: encoder args: 0 super: false) + ]. + readNode ifNil:[readNode := encoder encodeSelector: #get:]. + ^(rcvrNode sizeCodeForValue: encoder) + + (super sizeCodeForValue: encoder) + + (readNode sizeCode: encoder args: 1 super: false)! Item was added: + ParseNode subclass: #FutureNode + instanceVariableNames: 'receiver originalSelector futureSelector futureDelta futureArgs effectNode valueNode' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !FutureNode commentStamp: 'jcg 12/17/2009 02:03' prior: 0! + Compile-time transformation of #future and #future: messages. Use is best described through examples: + + receiver future doSomething: arg1 withArgs: arg2. + (receiver future: 2000) doSomethingElse + + The first means to immediately schedule #doSomething:withArgs: for asyncronous evaluation. The second means to wait 2000 milliseconds before scheduling #doSomethingElse for asynchronous evaluation. + + These are transformed into either #futureDo:at:args: or #futureSend:at:args:, depending on whether the result is used. Let's look at a few examples. + + [receiver future foo. 2+2] value. + true ifTrue: [^receiver future foo]. + arraySize := receiver future getArray wait size. + + In the first case, the result is never used, so the message #futureDo:at:args: is generated. In the second case, the result is answered from the current method. Since we don't do any cross-method analysis, we have to assume that the result is needed for a later computation. The result is provided in the form of a Promise, which will resolve to a value when the asynchronous evaluation has completed. Creating and resolving this Promise is the responsibility of #futureSend:at:args:, which is generated instead of #futureDo:at:args: when code-analysis indicates that the result of the message might be used. The third example is another one where #futureSend:at:args: is generated. + + See the default implementations of #futureDo:at:args: and #futureSend:at:args: in Object. Subclasses are free to override the default implementations to achieve specific effects. For example, this functionality originated in the Croquet class TFarRef. If you have a TFarRef to a replicated object, then sending 'aTFarRef future foo' results in a message being sent over the network to each replica of the object referenced by aTFarRef. We might also use far-refs, for example, to send a message to an object in another Hydra object-memory.! Item was added: + ----- Method: FutureNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitFutureNode: self! Item was added: + ----- Method: FutureNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + { receiver. futureDelta }, (futureArgs ifNil: [#()]) do: + [:node| + node == nil ifFalse: + [node analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools]]! Item was added: + ----- Method: FutureNode>>emitCodeForBlockValue:encoder: (in category 'code generation') ----- + emitCodeForBlockValue: stack encoder: encoder + "Generate code for evaluating the last statement in a block." + ^effectNode emitCodeForValue: stack encoder: encoder! Item was added: + ----- Method: FutureNode>>emitCodeForEffect:encoder: (in category 'code generation') ----- + emitCodeForEffect: stack encoder: encoder + ^effectNode emitCodeForEffect: stack encoder: encoder! Item was added: + ----- Method: FutureNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + ^valueNode emitCodeForValue: stack encoder: encoder! Item was added: + ----- Method: FutureNode>>futureMessage:arguments:from:sourceRange: (in category 'initialize-release') ----- + futureMessage: selName arguments: args from: encoder sourceRange: range + futureSelector := selName. + futureArgs := args. + ^self! Item was added: + ----- Method: FutureNode>>futureSelector (in category 'accessing') ----- + futureSelector + ^futureSelector! Item was added: + ----- Method: FutureNode>>isFutureNode (in category 'testing') ----- + isFutureNode + ^true! Item was added: + ----- Method: FutureNode>>originalSelector (in category 'accessing') ----- + originalSelector + ^originalSelector! Item was added: + ----- Method: FutureNode>>receiver (in category 'accessing') ----- + receiver + ^receiver! Item was added: + ----- Method: FutureNode>>receiver:selector:arguments:precedence:from:sourceRange: (in category 'initialize-release') ----- + receiver: rcvr selector: selector arguments: args precedence: p from: encoder sourceRange: range + receiver := rcvr. + originalSelector := selector. + originalSelector == #future: ifTrue:[futureDelta := args first]. + encoder noteSourceRange: range forNode: self.! Item was added: + ----- Method: FutureNode>>sizeCodeForBlockValue: (in category 'code generation') ----- + sizeCodeForBlockValue: encoder + receiver == NodeSuper ifTrue: [^self error: 'Futures cannot send to future']. + (futureArgs isNil or: [futureSelector isNil]) ifTrue: + [^self error: 'Futures must be sent messages']. + encoder sharableLitIndex: originalSelector. "to find its senders" + futureDelta ifNil:[futureDelta := encoder encodeLiteral: 0]. + effectNode := MessageNode new + receiver: receiver + selector: #futureDo:at:args: + arguments: (Array + with: (encoder encodeLiteral: futureSelector) + with: futureDelta + with: (BraceNode new elements: futureArgs)) + precedence: 3 + from: encoder. + ^effectNode sizeCodeForValue: encoder! Item was added: + ----- Method: FutureNode>>sizeCodeForEffect: (in category 'code generation') ----- + sizeCodeForEffect: encoder + receiver == NodeSuper ifTrue: [^self error: 'Futures cannot send to future']. + (futureArgs isNil or: [futureSelector isNil]) ifTrue: + [^self error: 'Futures must be sent messages']. + encoder sharableLitIndex: originalSelector. "to find its senders" + futureDelta ifNil:[futureDelta := encoder encodeLiteral: 0]. + effectNode := MessageNode new + receiver: receiver + selector: #futureDo:at:args: + arguments: (Array + with: (encoder encodeLiteral: futureSelector) + with: futureDelta + with: (BraceNode new elements: futureArgs)) + precedence: 3 + from: encoder. + ^effectNode sizeCodeForEffect: encoder! Item was added: + ----- Method: FutureNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + receiver == NodeSuper ifTrue: [^self error: 'Futures cannot send to future']. + (futureArgs isNil or: [futureSelector isNil]) ifTrue: + [^self error: 'Futures must be sent messages']. + encoder sharableLitIndex: originalSelector. "to find its senders" + futureDelta ifNil:[futureDelta := encoder encodeLiteral: 0]. + valueNode := MessageNode new + receiver: receiver + selector: #futureSend:at:args: + arguments: (Array + with: (encoder encodeLiteral: futureSelector) + with: futureDelta + with: (BraceNode new elements: futureArgs)) + precedence: 3 + from: encoder. + ^valueNode sizeCodeForValue: encoder! Item was added: + VariableNode subclass: #InstanceVariableNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! Item was added: + ----- Method: InstanceVariableNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitInstanceVariableNode: self! Item was added: + ----- Method: InstanceVariableNode>>emitCodeForStore:encoder: (in category 'code generation') ----- + emitCodeForStore: stack encoder: encoder + encoder genStoreInstVar: index! Item was added: + ----- Method: InstanceVariableNode>>emitCodeForStorePop:encoder: (in category 'code generation') ----- + emitCodeForStorePop: stack encoder: encoder + encoder genStorePopInstVar: index. + stack pop: 1! Item was added: + ----- Method: InstanceVariableNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + stack push: 1. + ^encoder genPushInstVar: index! Item was added: + ----- Method: InstanceVariableNode>>name:index: (in category 'initialize-release') ----- + name: varName index: varIndex + ^self name: varName index: varIndex-1 type: LdInstType! Item was added: + ----- Method: InstanceVariableNode>>sizeCodeForStore: (in category 'code generation') ----- + sizeCodeForStore: encoder + ^encoder sizeStoreInstVar: index! Item was added: + ----- Method: InstanceVariableNode>>sizeCodeForStorePop: (in category 'code generation') ----- + sizeCodeForStorePop: encoder + ^encoder sizeStorePopInstVar: index! Item was added: + ----- Method: InstanceVariableNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + ^encoder sizePushInstVar: index! Item was added: + SelectorNode subclass: #KeyWordNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Syntax'! + + !KeyWordNode commentStamp: '<historical>' prior: 0! + I am a part of a selector. #at:put: is owned by a SelectorNode, and #put: within it is owned by a KeyWordNode.! Item was added: + ParseNode subclass: #LeafNode + instanceVariableNames: 'key code index' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !LeafNode commentStamp: '<historical>' prior: 0! + I represent a leaf node of the compiler parse tree. I am abstract. + + Types (defined in class ParseNode): + 1 LdInstType (which uses class VariableNode) + 2 LdTempType (which uses class VariableNode) + 3 LdLitType (which uses class LiteralNode) + 4 LdLitIndType (which uses class VariableNode) + 5 SendType (which uses class SelectorNode). + + Note that Squeak departs slightly from the Blue Book bytecode spec. + + In order to allow access to more than 63 literals and instance variables, + bytecode 132 has been redefined as DoubleExtendedDoAnything: + byte2 byte3 Operation + (hi 3 bits) (lo 5 bits) + 0 nargs lit index Send Literal Message 0-255 + 1 nargs lit index Super-Send Lit Msg 0-255 + 2 ignored rcvr index Push Receiver Variable 0-255 + 3 ignored lit index Push Literal Constant 0-255 + 4 ignored lit index Push Literal Variable 0-255 + 5 ignored rcvr index Store Receiver Variable 0-255 + 6 ignored rcvr index Store-pop Receiver Variable 0-255 + 7 ignored lit index Store Literal Variable 0-255 + + This has allowed bytecode 134 also to be redefined as a second extended send + that can access literals up to 64 for nargs up to 3 without needing three bytes. + It is just like 131, except that the extension byte is aallllll instead of aaalllll, + where aaa are bits of argument count, and lll are bits of literal index.! Item was added: + ----- Method: LeafNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + "This is a no-op except in TempVariableNode" + ^self! Item was added: + ----- Method: LeafNode>>code (in category 'code generation') ----- + code + + ^ code! Item was added: + ----- Method: LeafNode>>code:type: (in category 'private') ----- + code: index type: type + + index isNil + ifTrue: [^type negated]. + (CodeLimits at: type) > index + ifTrue: [^(CodeBases at: type) + index]. + ^type * 256 + index! Item was added: + ----- Method: LeafNode>>emitCodeForEffect:encoder: (in category 'code generation') ----- + emitCodeForEffect: stack encoder: encoder + + ^self! Item was added: + ----- Method: LeafNode>>emitCodeForLoad:forValue:encoder: (in category 'code generation') ----- + emitCodeForLoad: stack forValue: forValue encoder: encoder + "Default is to do nothing. + Subclasses may need to override."! Item was added: + ----- Method: LeafNode>>index (in category 'accessing') ----- + index + "Answer the index of the receiver, which has various uses depending on the class of the receiver." + + ^index! Item was added: + ----- Method: LeafNode>>key (in category 'accessing') ----- + key + + ^key! Item was added: + ----- Method: LeafNode>>key:code: (in category 'initialize-release') ----- + key: object code: byte + + key := object. + code := byte! Item was added: + ----- Method: LeafNode>>key:index:type: (in category 'initialize-release') ----- + key: object index: i type: type + + key := object. + code := (self code: i type: type). + index := i! Item was added: + ----- Method: LeafNode>>name:key:code: (in category 'initialize-release') ----- + name: ignored key: object code: byte + + key := object. + code := byte! Item was added: + ----- Method: LeafNode>>reserve: (in category 'code generation') ----- + reserve: encoder + "If this is a yet unused literal of type -code, reserve it." + + code < 0 ifTrue: [code := self code: (index := encoder litIndex: key) type: 0 - code]! Item was added: + ----- Method: LeafNode>>resetFromCopy: (in category 'code generation') ----- + resetFromCopy: aLeafNode + "Reset the state of the recever to match that of the argument. + This is used to reset nodes that may have been repurposed + while generatig the compiled method for a full block." + + self assert: key == aLeafNode key. + code := aLeafNode code. + index := aLeafNode index! Item was added: + ----- Method: LeafNode>>sizeCodeForEffect: (in category 'code generation') ----- + sizeCodeForEffect: encoder + + ^0! Item was added: + ----- Method: LeafNode>>sizeCodeForLoad:forValue: (in category 'code generation') ----- + sizeCodeForLoad: encoder forValue: forValue + "Default is to do nothing. + Subclasses may need to override." + ^0! Item was added: + ----- Method: LeafNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + self subclassResponsibility! Item was added: + ----- Method: LeafNode>>veryDeepFixupWith: (in category 'copying') ----- + veryDeepFixupWith: deepCopier + "If fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!" + + super veryDeepFixupWith: deepCopier. + key := (deepCopier references at: key ifAbsent: [key]). + ! Item was added: + ----- Method: LeafNode>>veryDeepInner: (in category 'copying') ----- + veryDeepInner: deepCopier + "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." + + super veryDeepInner: deepCopier. + "key := key. Weakly copied" + code := code veryDeepCopyWith: deepCopier. + index := index veryDeepCopyWith: deepCopier. + ! Item was added: + LeafNode subclass: #LiteralNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !LiteralNode commentStamp: '<historical>' prior: 0! + I am a parse tree leaf representing a literal string or number.! Item was added: + ----- Method: LiteralNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitLiteralNode: self! Item was added: + ----- Method: LiteralNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + stack push: 1. + (encoder isSpecialLiteralForPush: key) + ifTrue: [encoder genPushSpecialLiteral: key] + ifFalse: [encoder genPushLiteral: index]! Item was added: + ----- Method: LiteralNode>>eval (in category 'evaluation') ----- + eval + "When everything in me is a constant, I can produce a value. This is only used by the Scripting system (TilePadMorph tilesFrom:in:)" + + ^ key! Item was added: + ----- Method: LiteralNode>>isConstantNumber (in category 'testing') ----- + isConstantNumber + ^ key isNumber! Item was added: + ----- Method: LiteralNode>>isLiteralNode (in category 'testing') ----- + isLiteralNode + + ^ true! Item was added: + ----- Method: LiteralNode>>isSpecialConstant (in category 'testing') ----- + isSpecialConstant + ^ code between: LdTrue and: LdMinus1+3! Item was added: + ----- Method: LiteralNode>>literalValue (in category 'testing') ----- + literalValue + + ^key! Item was added: + ----- Method: LiteralNode>>name:key:index:type: (in category 'initialize-release') ----- + name: literal key: object index: i type: type + "For compatibility with Encoder>>name:key:class:type:set:" + ^self key: object index: i type: type! Item was added: + ----- Method: LiteralNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + + key isVariableBinding ifTrue: + [key key isNil + ifTrue: + [aStream nextPutAll: '###'; nextPutAll: key value soleInstance name] + ifFalse: + [aStream nextPutAll: '##'; nextPutAll: key key]. + ^self]. + key isLiteral ifTrue: + [key printAsLiteralOn: aStream. + ^self]. + (key isCompiledCode and: [key isCompiledBlock]) ifTrue: + [key printOn: aStream. + ^self]. + key storeOn: aStream! Item was added: + ----- Method: LiteralNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + + key isVariableBinding + ifTrue: + [key key isNil + ifTrue: + [aStream nextPutAll: '###'; nextPutAll: key value soleInstance name] + ifFalse: + [aStream nextPutAll: '##'; nextPutAll: key key]] + ifFalse: + [key storeOn: aStream]! Item was added: + ----- Method: LiteralNode>>reserve: (in category 'code generation') ----- + reserve: encoder + "If this is a yet unused literal of type -code, reserve it." + + code < 0 ifTrue: + [index := key isVariableBinding "true if sending value[:] to a special binding" + ifTrue: [encoder sharableLitIndex: key] + ifFalse: [encoder litIndex: key]. + code := self code: index type: 0 - code]! Item was added: + ----- Method: LiteralNode>>resetForBlockGeneration (in category 'code generation') ----- + resetForBlockGeneration + "Reset the receiver to an unassigned state such that its index + in the encoder's literalStream is as yet to be determined." + code := LdLitType negated. + index := nil! Item was added: + ----- Method: LiteralNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + self reserve: encoder. + ^(encoder isSpecialLiteralForPush: key) + ifTrue: [encoder sizePushSpecialLiteral: key] + ifFalse: [encoder sizePushLiteral: index]! Item was added: + VariableNode subclass: #LiteralVariableNode + instanceVariableNames: 'readNode writeNode' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! Item was added: + ----- Method: LiteralVariableNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitLiteralVariableNode: self! Item was added: + ----- Method: LiteralVariableNode>>assignmentCheck:at: (in category 'testing') ----- + assignmentCheck: encoder at: location + ^(key isVariableBinding and: [key canAssign not]) + ifTrue: [location] + ifFalse: [-1]! Item was added: + ----- Method: LiteralVariableNode>>emitCodeForLoad:forValue:encoder: (in category 'code generation') ----- + emitCodeForLoad: stack forValue: forValue encoder: encoder + "If a normal literal variable (not sending value:), do nothing. + If for value (e.g. v := Binding := expr) do nothing; the work will be done in emitCodeForStore:encoder:. + If not for value then indeed load. The rest of the work will be done in emitCodeForStorePop:encoder:." + (writeNode isNil or: [forValue]) ifTrue: [^self]. + encoder genPushLiteral: index. + stack push: 1! Item was added: + ----- Method: LiteralVariableNode>>emitCodeForStore:encoder: (in category 'code generation') ----- + emitCodeForStore: stack encoder: encoder + | exprOffset | + writeNode ifNil: [^encoder genStoreLiteralVar: index]. + "On entry the stack has only the expression. Push the binding, + duplicate the expression, send #value: and pop. + The various value: methods on Association ReadOnlyVariableBinding + etc _do not_ return the value assigned; they return the receiver. If they + did we could generate much simpler code, e.g. + encoder genPushLiteral: index. + stack push: 1. + writeNode emitCode: stack args: 1 encoder: encoder super: false" + exprOffset := stack position - 1. + encoder genPushLiteral: index. + stack push: 1. + encoder genPushTempLong: exprOffset. + stack push: 1. + writeNode + emitCode: stack + args: 1 + encoder: encoder + super: false. + stack pop: 1. + encoder genPop! Item was added: + ----- Method: LiteralVariableNode>>emitCodeForStorePop:encoder: (in category 'code generation') ----- + emitCodeForStorePop: stack encoder: encoder + writeNode ifNil: + [stack pop: 1. + ^encoder genStorePopLiteralVar: index]. + writeNode + emitCode: stack + args: 1 + encoder: encoder + super: false. + stack pop: 1. + encoder genPop! Item was added: + ----- Method: LiteralVariableNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + ^readNode + ifNil: [stack push: 1. + encoder genPushLiteralVar: index] + ifNotNil: [readNode emitCodeForValue: stack encoder: encoder]! Item was added: + ----- Method: LiteralVariableNode>>resetForBlockGeneration (in category 'code generation') ----- + resetForBlockGeneration + "Reset the receiver to an unassigned state such that its index + in the encoder's literalStream is as yet to be determined." + code := LdLitIndType negated. + index := nil! Item was added: + ----- Method: LiteralVariableNode>>resetFromCopy: (in category 'code generation') ----- + resetFromCopy: aLiteralVariableNode + "Reset the state of the recever to match that of the argument. + This is used to reset nodes that may have been repurposed + while generatig the compiled method for a full block." + + self assert: (readNode == (aLiteralVariableNode instVarNamed: 'readNode') + and: [writeNode == (aLiteralVariableNode instVarNamed: 'writeNode')]). + super resetFromCopy: aLiteralVariableNode! Item was added: + ----- Method: LiteralVariableNode>>sizeCodeForLoad:forValue: (in category 'code generation') ----- + sizeCodeForLoad: encoder forValue: forValue + self reserve: encoder. + ^(key isVariableBinding and: [key isSpecialWriteBinding and: [forValue not]]) + ifTrue: [encoder sizePushLiteral: index] + ifFalse: [0]! Item was added: + ----- Method: LiteralVariableNode>>sizeCodeForStore: (in category 'code generation') ----- + sizeCodeForStore: encoder + self reserve: encoder. + (key isVariableBinding and: [key isSpecialWriteBinding]) ifFalse: + [^encoder sizeStoreLiteralVar: index]. + writeNode := encoder encodeSelector: #value:. + "On entry the stack has only the expression. Push the binding, + duplicate the expression, send #value: and pop." + ^(encoder sizePushLiteral: index) + + (encoder sizePushTempLong: 0) "we don't know yet, hence long, sigh..." + + (writeNode sizeCode: encoder args: 1 super: false) + + encoder sizePop! Item was added: + ----- Method: LiteralVariableNode>>sizeCodeForStorePop: (in category 'code generation') ----- + sizeCodeForStorePop: encoder + self reserve: encoder. + ^(key isVariableBinding and: [key isSpecialWriteBinding]) + ifTrue: [ writeNode := encoder encodeSelector: #value:. + ^ (writeNode sizeCode: encoder args: 1 super: false) + + encoder sizePop] + ifFalse: [encoder sizeStorePopLiteralVar: index]! Item was added: + ----- Method: LiteralVariableNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + self reserve: encoder. + (key isVariableBinding and: [key isSpecialReadBinding]) + ifFalse: + [^encoder sizePushLiteralVar: index]. + readNode := MessageNode new + receiver: (encoder encodeLiteral: key) + selector: (encoder encodeSelector: #value) + arguments: #() + precedence: #value precedence. + ^readNode sizeCodeForValue: encoder! Item was added: + InstanceVariableNode subclass: #MaybeContextInstanceVariableNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !MaybeContextInstanceVariableNode commentStamp: '<historical>' prior: 0! + This class conspires to arrange that inst var access for contexts is done exclusively using the long-form instance variabl;e access bytecodes. See InstructionStream class>>variablesAndOffsetsDo:. + + A virtual machine can benefit in performance by organizing method and block activations using a more conventional stack organization than by using first-class activation records (contexts). But such a virtual machine is also cabable of hiding the stack and making it appear as if contexts are still used. This means the system has better performance but still has all the benefits of first-class activation records. To pull this off the VM needs to intercept any and all accesses to context objects so that it can make contexts function as proxy objects for stack frames. + + Without help from the image such a virtual machine based on an interpreter would have to perform an expensive check on all instance variable accesses to determine if the instance variable was that of a context serving as a proxy for a stack frame. A simple hack is to take advantage of the short and long forms of instance variable access bytecodes. The BlueBook instruction set (and likely any bytecode set evolved from it) has short form bytecodes for fetching and storing the first few bytecodes (BlueBook fetch first 16, store first 8). Contexts typically have at most 6 instance variables. If we arrange to use the long-form bytecodes for all context inst var accesses then we only have to check for context inst var access in long-form bytecodes, and then only if the index is within the context inst var range. This effectively makes the check free because on modern processors checking an index fetched from memory into a register against a constant costs far less than the memry rea d to fetch the index.! Item was added: + ----- Method: MaybeContextInstanceVariableNode>>code (in category 'accessing') ----- + code + "Answer a bogus code to avoid creating quick methods. + See MethodNode>>generate:ifQuick:" + ^LoadLong! Item was added: + ----- Method: MaybeContextInstanceVariableNode>>emitCodeForStore:encoder: (in category 'code generation') ----- + emitCodeForStore: stack encoder: encoder + encoder genStoreInstVarLong: index! Item was added: + ----- Method: MaybeContextInstanceVariableNode>>emitCodeForStorePop:encoder: (in category 'code generation') ----- + emitCodeForStorePop: stack encoder: encoder + encoder genStorePopInstVarLong: index. + stack pop: 1! Item was added: + ----- Method: MaybeContextInstanceVariableNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + stack push: 1. + ^encoder genPushInstVarLong: index! Item was added: + ----- Method: MaybeContextInstanceVariableNode>>sizeCodeForStore: (in category 'code generation') ----- + sizeCodeForStore: encoder + ^encoder sizeStoreInstVarLong: index! Item was added: + ----- Method: MaybeContextInstanceVariableNode>>sizeCodeForStorePop: (in category 'code generation') ----- + sizeCodeForStorePop: encoder + ^encoder sizeStorePopInstVarLong: index! Item was added: + ----- Method: MaybeContextInstanceVariableNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + ^encoder sizePushInstVarLong: index! Item was added: + MessageNode subclass: #MessageAsTempNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !MessageAsTempNode commentStamp: '<historical>' prior: 0! + This node represents accesses to temporary variables for do-its in the debugger. Since they execute in another context, they must send a message to the original context to access the value of the temporary variable in that context.! Item was added: + ----- Method: MessageAsTempNode>>asStorableNode: (in category 'access to remote temps') ----- + asStorableNode: encoder + "This node is a message masquerading as a temporary variable. + It currently has the form {homeContext tempAt: offset}. + We need to generate code for {expr storeAt: offset inTempFrame: homeContext}, + where the expr, the block argument, is already on the stack. + This, in turn will get turned into {homeContext tempAt: offset put: expr} + at runtime if nobody disturbs storeAt:inTempFrame: in Object (not clean)" + ^ MessageAsTempNode new + receiver: nil "suppress code generation for reciever already on stack" + selector: #storeAt:inTempFrame: + arguments: (arguments copyWith: receiver) + precedence: precedence + from: encoder! Item was added: + ----- Method: MessageAsTempNode>>code (in category 'access to remote temps') ----- + code + "Allow synthetic temp nodes to be sorted by code" + ^ arguments first literalValue! Item was added: + ----- Method: MessageAsTempNode>>emitCodeForStorePop:encoder: (in category 'code generation') ----- + emitCodeForStorePop: stack encoder: encoder + "This node has the form {expr storeAt: offset inTempFrame: homeContext}, + where the expr, the block argument, is already on the stack." + ^self emitCodeForEffect: stack encoder: encoder! Item was added: + ----- Method: MessageAsTempNode>>sizeCodeForStorePop: (in category 'code generation') ----- + sizeCodeForStorePop: encoder + "This node has the form {expr storeAt: offset inTempFrame: homeContext}, + where the expr, the block argument, is already on the stack." + ^self sizeCodeForEffect: encoder! Item was added: + ----- Method: MessageAsTempNode>>store:from: (in category 'access to remote temps') ----- + store: expr from: encoder + "ctxt tempAt: n -> ctxt tempAt: n put: expr (see Assignment). + For assigning into temps of a context being debugged." + + selector key ~= #namedTempAt: + ifTrue: [^self error: 'cant transform this message']. + ^ MessageAsTempNode new + receiver: receiver + selector: #namedTempAt:put: + arguments: (arguments copyWith: expr) + precedence: precedence + from: encoder! Item was added: + ParseNode subclass: #MessageNode + instanceVariableNames: 'receiver selector precedence special arguments sizes equalNode caseErrorNode originalReceiver originalSelector originalArguments' + classVariableNames: 'MacroEmitters MacroPrinters MacroSelectors MacroSizers MacroTransformers StdTypers ThenFlag' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !MessageNode commentStamp: '<historical>' prior: 0! + I represent a receiver and its message. + + Precedence codes: + 1 unary + 2 binary + 3 keyword + 4 other + + If special>0, I compile special code in-line instead of sending messages with literal methods as remotely copied contexts.! Item was added: + ----- Method: MessageNode class>>initialize (in category 'class initialization') ----- + initialize + "MessageNode initialize" + MacroSelectors := + #( ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue: + and: or: + whileFalse: whileTrue: whileFalse whileTrue + to:do: to:by:do: + caseOf: caseOf:otherwise: + ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil: + repeat ). + MacroTransformers := + #( transformIfTrue: transformIfFalse: transformIfTrueIfFalse: transformIfFalseIfTrue: + transformAnd: transformOr: + transformWhile: transformWhile: transformWhile: transformWhile: + transformToDo: transformToDo: + transformCase: transformCase: + transformIfNil: transformIfNil: transformIfNilIfNotNil: transformIfNotNilIfNil: + transformRepeat: ). + MacroEmitters := + #( emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: + emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: + emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: + emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value: + emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value: + emitCodeForToDo:encoder:value: emitCodeForToDo:encoder:value: + emitCodeForCase:encoder:value: emitCodeForCase:encoder:value: + emitCodeForIfNil:encoder:value: emitCodeForIfNil:encoder:value: + emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: + emitCodeForRepeat:encoder:value:). + MacroSizers := + #( sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: + sizeCodeForIf:value: sizeCodeForIf:value: + sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value: + sizeCodeForToDo:value: sizeCodeForToDo:value: + sizeCodeForCase:value: sizeCodeForCase:value: + sizeCodeForIfNil:value: sizeCodeForIfNil:value: sizeCodeForIf:value: sizeCodeForIf:value: + sizeCodeForRepeat:value:). + MacroPrinters := + #( printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent: + printIfOn:indent: printIfOn:indent: + printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: + printToDoOn:indent: printToDoOn:indent: + printCaseOn:indent: printCaseOn:indent: + printIfNil:indent: printIfNil:indent: printIfNilNotNil:indent: printIfNilNotNil:indent: + printRepeatOn:indent:)! Item was added: + ----- Method: MessageNode class>>isMacroEmitter: (in category 'browsing support') ----- + isMacroEmitter: aLiteral + "Let our macro methods be found when browsing senders" + ^aLiteral isSymbol + and: [MacroEmitters includes: aLiteral]! Item was added: + ----- Method: MessageNode class>>isMacroPrinter: (in category 'browsing support') ----- + isMacroPrinter: aLiteral + "Let our macro methods be found when browsing senders" + ^aLiteral isSymbol + and: [MacroPrinters includes: aLiteral] + ! Item was added: + ----- Method: MessageNode class>>isMacroSizer: (in category 'browsing support') ----- + isMacroSizer: aLiteral + "Let our macro methods be found when browsing senders" + ^aLiteral isSymbol + and: [MacroSizers includes: aLiteral] + ! Item was added: + ----- Method: MessageNode class>>isMacroTransformer: (in category 'browsing support') ----- + isMacroTransformer: aLiteral + "Let our macro methods be found when browsing senders" + ^aLiteral isSymbol + and: [MacroTransformers includes: aLiteral]! Item was added: + ----- Method: MessageNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitMessageNode: self! Item was added: + ----- Method: MessageNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + "Assignments within optimized loops are tricky. Because a loop repeats a + write to a temporary in an optimized loop effectively occurs after the loop. + To handle this collect the set of temps assigned to in optimized loops and + add extra writes after traversing the optimized loop constituents." + | writtenToTemps | + self isOptimizedLoop ifTrue: + [{ receiver }, arguments do: + [:node| + (node notNil and: [node isBlockNode and: [node optimized]]) ifTrue: + [assignmentPools at: node put: Set new]]]. + "receiver is nil in cascades" + receiver == nil ifFalse: + [receiver analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools]. + arguments do: + [:node| + node == nil ifFalse: "last argument of optimized to:do: can be nil" + [node analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools]]. + "Add assignments representing subsequent iterations + and redo the closure analysis for the written-to temps." + self isOptimizedLoop ifTrue: + [writtenToTemps := Set new. + { receiver }, arguments do: + [:node| + (node notNil and: [node isBlockNode and: [node optimized]]) ifTrue: + [(assignmentPools removeKey: node) do: + [:temp| + temp isBlockArg ifFalse: "ignore added assignments to to:do: loop args" + [writtenToTemps add: temp. + temp addWriteWithin: node at: rootNode locationCounter]]]]. + writtenToTemps isEmpty ifFalse: + [(writtenToTemps sorted: ParseNode tempSortBlock) do: + [:each| each analyseClosure: rootNode]. + (writtenToTemps collect: [:each| each definingScope]) do: + [:blockNode| + blockNode ifHasRemoteTempNodeEnsureInitializationStatementExists: rootNode]]]! Item was added: + ----- Method: MessageNode>>arguments (in category 'equation translation') ----- + arguments + ^arguments! Item was added: + ----- Method: MessageNode>>arguments: (in category 'equation translation') ----- + arguments: list + arguments := list! Item was added: + ----- Method: MessageNode>>argumentsInEvaluationOrder (in category 'visiting') ----- + argumentsInEvaluationOrder + "Answer the receiver's arguments in evaluation order. + If the receiver is a transformed to:do: node this will undo the misordering done by the transformation." + ^(special > 0 + and: [(MacroTransformers at: special) == #transformToDo: + and: [arguments size >= 7]]) + "arguments are in a weird order and may be nil in a transformed to:do: loop. sigh... + c.f. emitCodeForToDo:encoder:value:" + ifTrue: + [(arguments at: 7) "limitInit" + ifNil: [{ arguments at: 4. "initStmt" + arguments at: 5. "test" + arguments at: 3. "block" + arguments at: 6 "incStmt" }] + ifNotNil: [:limitInit| + { limitInit. + arguments at: 4. "initStmt" + arguments at: 5. "test" + arguments at: 3. "block" + arguments at: 6 "incStmt" }]] + ifFalse: + [arguments]! Item was added: + ----- Method: MessageNode>>asMorphicCaseOn:indent: (in category 'printing') ----- + asMorphicCaseOn: parent indent: ignored + "receiver caseOf: {[key]->[value]. ...} otherwise: [otherwise]" + + | braceNode otherwise | + + braceNode := arguments first. + otherwise := arguments last. + ((arguments size = 1) or: [otherwise isJustCaseError]) ifTrue: [ + self morphFromKeywords: #caseOf: arguments: {braceNode} on: parent indent: nil. + ^parent + ]. + self morphFromKeywords: #caseOf:otherwise: arguments: arguments on: parent indent: nil. + ^parent + ! Item was added: + ----- Method: MessageNode>>canCascade (in category 'testing') ----- + canCascade + + ^receiver ~~ NodeSuper! Item was added: + ----- Method: MessageNode>>cascadeReceiver (in category 'cascading') ----- + cascadeReceiver + "Nil out rcvr (to indicate cascade) and return what it had been." + + | rcvr | + rcvr := receiver. + receiver := nil. + ^rcvr! Item was added: + ----- Method: MessageNode>>checkBlock:as:from:maxArgs: (in category 'private') ----- + checkBlock: node as: nodeName from: encoder maxArgs: maxArgs + "Answer true if node is a BlockNode with at most maxArgs arguments. + This check is required in order to inline some special messages. + Notify some undue usage of these special messages." + + node isBlockNode ifFalse: [ ^false ]. + node numberOfArguments <= maxArgs ifTrue: [ ^true ]. + ^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' has too many arguments'! Item was added: + ----- Method: MessageNode>>emitCodeForCase:encoder:value: (in category 'code generation') ----- + emitCodeForCase: stack encoder: encoder value: forValue + + | braceNode sizeStream allReturn | + forValue ifFalse: + [^super emitCodeForEffect: stack encoder: encoder]. + braceNode := arguments first. + sizeStream := ReadStream on: sizes. + receiver emitCodeForValue: stack encoder: encoder. + "There must be at least one branch around the otherwise/caseError + so the decompiler can identify the end of the otherwise/caseError." + allReturn := true. "assume every case ends with a return" + braceNode casesForwardDo: + [:keyNode :valueNode :last | + | thenSize elseSize dropReceiver | + dropReceiver := last and: [arguments size >= 2]. + thenSize := sizeStream next. + elseSize := sizeStream next. + dropReceiver ifFalse: [encoder genDup. stack push: 1]. + keyNode emitCodeForEvaluatedValue: stack encoder: encoder. + keyNode pc: encoder nextPC. + equalNode emitCode: stack args: 1 encoder: encoder. + self emitCodeForBranchOn: false dist: thenSize pop: stack encoder: encoder. + dropReceiver ifFalse: [encoder genPop. stack pop: 1]. + valueNode emitCodeForEvaluatedValue: stack encoder: encoder. + dropReceiver ifTrue: [stack pop: 1]. + valueNode returns ifFalse: + [self emitCodeForJump: elseSize encoder: encoder. + allReturn := false]. + (last and: [allReturn]) ifTrue: + [self emitCodeForJump: elseSize encoder: encoder]]. + arguments size = 2 + ifTrue: + [arguments last emitCodeForEvaluatedValue: stack encoder: encoder] "otherwise: [...]" + ifFalse: + ["the receiver of caseOf: has been previously dup, just send" + caseErrorNode emitCode: stack args: 0 encoder: encoder]! Item was added: + ----- Method: MessageNode>>emitCodeForEffect:encoder: (in category 'code generation') ----- + emitCodeForEffect: stack encoder: encoder + "For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly." + <hasLiteralTest: #isMacroEmitter:> + special > 0 + ifTrue: + [pc := 0. + self perform: (MacroEmitters at: special) with: stack with: encoder with: false] + ifFalse: + [super emitCodeForEffect: stack encoder: encoder]! Item was added: + ----- Method: MessageNode>>emitCodeForIf:encoder:value: (in category 'code generation') ----- + emitCodeForIf: stack encoder: encoder value: forValue + | thenExpr thenSize elseExpr elseSize | + thenSize := sizes at: 1. + elseSize := sizes at: 2. + thenExpr := arguments at: 1. + elseExpr := arguments at: 2. + receiver emitCodeForValue: stack encoder: encoder. + pc := encoder nextPC. + elseSize * thenSize > 0 + ifTrue: "Code for two-armed" + [self emitCodeForBranchOn: false dist: thenSize pop: stack encoder: encoder. + thenExpr emitCodeForEvaluatedValue: stack encoder: encoder. + stack pop: 1. "then and else alternate; they don't accumulate" + thenExpr returns ifFalse: "Elide jump over else after a return" + [self emitCodeForJump: elseSize encoder: encoder]. + elseExpr emitCodeForEvaluatedValue: stack encoder: encoder. + forValue ifFalse: "Two-armed IFs forEffect share a single pop - except if both return" + [(arguments allSatisfy: #returns) ifFalse: [encoder genPop]. + stack pop: 1]] + ifFalse: "One arm is empty here (this can only ever be for effect)" + [thenSize > 0 + ifTrue: + [self emitCodeForBranchOn: false dist: thenSize pop: stack encoder: encoder. + thenExpr emitCodeForEvaluatedEffect: stack encoder: encoder] + ifFalse: + [self emitCodeForBranchOn: true dist: elseSize pop: stack encoder: encoder. + elseExpr emitCodeForEvaluatedEffect: stack encoder: encoder]]! Item was added: + ----- Method: MessageNode>>emitCodeForIfNil:encoder:value: (in category 'code generation') ----- + emitCodeForIfNil: stack encoder: encoder value: forValue + + | theNode theSize ifNotNilSelector | + theNode := arguments first. + theSize := sizes at: 1. + ifNotNilSelector := #ifNotNil:. + receiver emitCodeForValue: stack encoder: encoder. + forValue ifTrue: [encoder genDup. stack push: 1]. + encoder genPushSpecialLiteral: nil. stack push: 1. + equalNode emitCode: stack args: 1 encoder: encoder. + pc := encoder nextPC. + self + emitCodeForBranchOn: (selector key == ifNotNilSelector) + dist: theSize + pop: stack + encoder: encoder. + forValue + ifTrue: + [encoder genPop. stack pop: 1. + theNode emitCodeForEvaluatedValue: stack encoder: encoder] + ifFalse: [theNode emitCodeForEvaluatedEffect: stack encoder: encoder]! Item was added: + ----- Method: MessageNode>>emitCodeForRepeat:encoder:value: (in category 'code generation') ----- + emitCodeForRepeat: stack encoder: encoder value: forValue + " L1: ... Jmp(L1)" + | loopSize | + loopSize := sizes at: 1. + receiver emitCodeForEvaluatedEffect: stack encoder: encoder. + self emitCodeForJump: 0 - loopSize encoder: encoder. + forValue ifTrue: [encoder genPushSpecialLiteral: nil. stack push: 1]! Item was added: + ----- Method: MessageNode>>emitCodeForToDo:encoder:value: (in category 'code generation') ----- + emitCodeForToDo: stack encoder: encoder value: forValue + " var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] Jmp(L1) L2: " + | loopSize initStmt limitInit test block incStmt blockSize | + initStmt := arguments at: 4. + limitInit := arguments at: 7. + test := arguments at: 5. + block := arguments at: 3. + incStmt := arguments at: 6. + blockSize := sizes at: 1. + loopSize := sizes at: 2. + + "This will return the receiver of to:do: which is the initial value of the loop" + forValue + ifTrue: [initStmt emitCodeForValue: stack encoder: encoder] + ifFalse: [initStmt emitCodeForEffect: stack encoder: encoder]. + limitInit ifNotNil: + [limitInit emitCodeForEffect: stack encoder: encoder]. + test emitCodeForValue: stack encoder: encoder. + pc := encoder nextPC. + self emitCodeForBranchOn: false dist: blockSize pop: stack encoder: encoder. + block emitCodeForEvaluatedEffect: stack encoder: encoder. + incStmt emitCodeForEffect: stack encoder: encoder. + self emitCodeForJump: 0 - loopSize encoder: encoder! Item was added: + ----- Method: MessageNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + "For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly." + <hasLiteralTest: #isMacroEmitter:> + special > 0 + ifTrue: + [pc := 0. + self perform: (MacroEmitters at: special) with: stack with: encoder with: true] + ifFalse: + [receiver ~~ nil ifTrue: [receiver emitCodeForValue: stack encoder: encoder]. + arguments do: [:argument | argument emitCodeForValue: stack encoder: encoder]. + pc := encoder nextPC. "debug pc is first byte of the send, i.e. the next byte". + selector + emitCode: stack + args: arguments size + encoder: encoder + super: receiver == NodeSuper]! Item was added: + ----- Method: MessageNode>>emitCodeForWhile:encoder:value: (in category 'code generation') ----- + emitCodeForWhile: stack encoder: encoder value: forValue + "L1: ... Bfp(L2)|Btp(L2) ... Jmp(L1) L2: " + | cond stmt stmtSize loopSize | + cond := receiver. + stmt := arguments at: 1. + stmtSize := sizes at: 1. + loopSize := sizes at: 2. + cond emitCodeForEvaluatedValue: stack encoder: encoder. + pc := encoder nextPC. + self emitCodeForBranchOn: (selector key == #whileFalse:) "Bfp for whileTrue" + dist: stmtSize pop: stack encoder: encoder. "Btp for whileFalse" + stmt emitCodeForEvaluatedEffect: stack encoder: encoder. + self emitCodeForJump: 0 - loopSize encoder: encoder. + forValue ifTrue: [encoder genPushSpecialLiteral: nil. stack push: 1]! Item was added: + ----- Method: MessageNode>>ensureCanCascade: (in category 'cascading') ----- + ensureCanCascade: encoder + special > 0 ifTrue: + [special := 0. + receiver := originalReceiver. + selector := encoder encodeSelector: originalSelector. + arguments := originalArguments. + receiver isBlockNode ifTrue: [receiver deoptimize]. + arguments do: + [:each| + (each isBlockNode or: [each isBraceNode]) ifTrue: + [each deoptimize]]]! Item was added: + ----- Method: MessageNode>>eval (in category 'equation translation') ----- + eval + "When everything in me is a constant, I can produce a value. This is only used by the Scripting system (TilePadMorph tilesFrom:in:)" + + | rec args | + receiver isVariableNode ifFalse: [^ #illegal]. + rec := receiver key value. + args := arguments collect: [:each | each eval]. + ^ rec perform: selector key withArguments: args! Item was added: + ----- Method: MessageNode>>ifNilReceiver (in category 'private') ----- + ifNilReceiver + + ^receiver! Item was added: + ----- Method: MessageNode>>ifNilTemporary (in category 'private') ----- + ifNilTemporary + + ^ self ifNilReceiver ifNilTemporary! Item was added: + ----- Method: MessageNode>>isComplex (in category 'testing') ----- + isComplex + + ^(special between: 1 and: 10) or: [arguments size > 2 or: [receiver isComplex]]! Item was added: + ----- Method: MessageNode>>isMessage (in category 'testing') ----- + isMessage + ^true! Item was added: + ----- Method: MessageNode>>isMessage:receiver:arguments: (in category 'testing') ----- + isMessage: selSymbol receiver: rcvrPred arguments: argsPred + "Answer whether selector is selSymbol, and the predicates rcvrPred and argsPred + evaluate to true with respect to receiver and the list of arguments. If selSymbol or + either predicate is nil, it means 'don't care'. Note that argsPred takes numArgs + arguments. All block arguments are ParseNodes." + + ^(selSymbol isNil or: [selSymbol==selector key]) and: + [(rcvrPred isNil or: [rcvrPred value: receiver]) and: + [(argsPred isNil or: [argsPred valueWithArguments: arguments])]]! Item was added: + ----- Method: MessageNode>>isMessageNode (in category 'testing') ----- + isMessageNode + ^true! Item was added: + ----- Method: MessageNode>>isNilIf (in category 'testing') ----- + isNilIf + + ^(special between: 3 and: 4) + and: [(arguments first returns or: [arguments first isJust: NodeNil]) + and: [(arguments last returns or: [arguments last isJust: NodeNil])]]! Item was added: + ----- Method: MessageNode>>isOptimized (in category 'testing') ----- + isOptimized + ^special > 0! Item was added: + ----- Method: MessageNode>>isOptimizedLoop (in category 'testing') ----- + isOptimizedLoop + ^special > 0 + and: [#(transformWhile: transformToDo: transformRepeat:) includes: (MacroTransformers at: special)]! Item was added: + ----- Method: MessageNode>>isOptimizedWhileLoop (in category 'testing') ----- + isOptimizedWhileLoop + ^special > 0 + and: [#(transformWhile: transformRepeat:) includes: (MacroTransformers at: special)]! Item was added: + ----- Method: MessageNode>>isReturningIf (in category 'testing') ----- + isReturningIf + + ^((special between: 3 and: 4) "ifTrue:ifFalse:/ifFalse:ifTrue:" + or: [special between: 17 and: 18]) "ifNil:ifNotNil:/ifNotNil:ifNil:" + and: [arguments first returns and: [arguments last returns]]! Item was added: + ----- Method: MessageNode>>macroPrinter (in category 'printing') ----- + macroPrinter + + special > 0 ifTrue: [^MacroPrinters at: special]. + ^nil + ! Item was added: + ----- Method: MessageNode>>noteSpecialSelector: (in category 'macro transformations') ----- + noteSpecialSelector: selectorSymbol + "special > 0 denotes specially treated (potentially inlined) messages. " + + special := MacroSelectors indexOf: selectorSymbol. + ! Item was added: + ----- Method: MessageNode>>precedence (in category 'printing') ----- + precedence + + ^precedence! Item was added: + ----- Method: MessageNode>>printCaseOn:indent: (in category 'printing') ----- + printCaseOn: aStream indent: level + "receiver caseOf: {[key]->[value]. ...} otherwise: [otherwise]" + | braceNode otherwise extra | + braceNode := arguments first. + otherwise := arguments last. + (arguments size = 1 or: [otherwise isJustCaseError]) ifTrue: + [otherwise := nil]. + receiver + printOn: aStream + indent: level + precedence: 3. + aStream nextPutAll: ' caseOf: '. + braceNode isVariableReference + ifTrue: [braceNode printOn: aStream indent: level] + ifFalse: + [aStream nextPutAll: '{'; crtab: level + 1. + braceNode casesForwardDo: + [:keyNode :valueNode :last | + keyNode printOn: aStream indent: level + 1. + aStream nextPutAll: ' -> '. + valueNode isComplex + ifTrue: + [aStream crtab: level + 2. + extra := 1] + ifFalse: [extra := 0]. + valueNode printOn: aStream indent: level + 1 + extra. + last ifTrue: [aStream nextPut: $}] + ifFalse: [aStream nextPut: $.; + crtab: level + 1]]]. + otherwise notNil ifTrue: + [aStream crtab: level + 1; nextPutAll: ' otherwise: '. + extra := otherwise isComplex + ifTrue: + [aStream crtab: level + 2. + 1] + ifFalse: [0]. + otherwise printOn: aStream indent: level + 1 + extra]! Item was added: + ----- Method: MessageNode>>printIfNil:indent: (in category 'printing') ----- + printIfNil: aStream indent: level + + self printReceiver: receiver on: aStream indent: level. + + ^self printKeywords: selector key + arguments: (Array with: arguments first) + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>printIfNilNotNil:indent: (in category 'printing') ----- + printIfNilNotNil: aStream indent: level + + (arguments first isJust: NodeNil) ifTrue: + [self printReceiver: receiver ifNilReceiver ifNilValue on: aStream indent: level. + ^ self + printKeywords: #ifNotNil: + arguments: { arguments second } + on: aStream indent: level]. + + (arguments second isJust: NodeNil) ifTrue: + [self printReceiver: receiver ifNilReceiver on: aStream indent: level. + ^ self + printKeywords: #ifNil: + arguments: { arguments first } + on: aStream indent: level]. + + self printReceiver: receiver ifNilReceiver ifNilValue on: aStream indent: level. + ^ self + printKeywords: #ifNil:ifNotNil: + arguments: arguments + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>printIfOn:indent: (in category 'printing') ----- + printIfOn: aStream indent: level + + receiver ifNotNil: + [receiver printOn: aStream indent: level + 1 precedence: precedence]. + (arguments last isJust: NodeNil) ifTrue: + [^self printKeywords: #ifTrue: arguments: (Array with: arguments first) + on: aStream indent: level]. + (arguments last isJust: NodeFalse) ifTrue: + [^self printKeywords: #and: arguments: (Array with: arguments first) + on: aStream indent: level]. + (arguments first isJust: NodeNil) ifTrue: + [^self printKeywords: #ifFalse: arguments: (Array with: arguments last) + on: aStream indent: level]. + (arguments first isJust: NodeTrue) ifTrue: + [^self printKeywords: #or: arguments: (Array with: arguments last) + on: aStream indent: level]. + self printKeywords: #ifTrue:ifFalse: arguments: arguments + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>printKeywords:arguments:on:indent: (in category 'printing') ----- + printKeywords: key arguments: args on: aStream indent: level + | keywords indent arg kwd doCrTab | + args size = 0 ifTrue: + [aStream space; nextPutAll: key. + ^self]. + keywords := key asString keywords. + doCrTab := args size > 2 + or: [{receiver} , args anySatisfy: + [:thisArg | + thisArg notNil + and: [thisArg isBlockNode + or: [thisArg isMessageNode and: [thisArg precedence >= 3]]]]]. + 1 to: (args size min: keywords size) do: + [:i | + arg := args at: i. + kwd := keywords at: i. + doCrTab + ifTrue: [aStream crtab: level+1. indent := 1] "newline after big args" + ifFalse: [aStream space. indent := 0]. + aStream nextPutAll: kwd; space. + arg printOn: aStream + indent: level + 1 + indent + precedence: (precedence = 2 ifTrue: [1] ifFalse: [precedence])]! Item was added: + ----- Method: MessageNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + "may not need this check anymore - may be fixed by the #receiver: change" + <hasLiteralTest: #isMacroPrinter:> + + special ifNil: [^aStream nextPutAll: '** MessageNode with nil special **']. + + special > 0 ifTrue: + [^self perform: self macroPrinter with: aStream with: level]. + + self printReceiver: receiver on: aStream indent: level. + selector isForFFICall + ifTrue: + [aStream space. + selector + printAsFFICallWithArguments: arguments + on: aStream + indent: 0] + ifFalse: + [self printKeywords: selector key + arguments: arguments + on: aStream + indent: level]! Item was added: + ----- Method: MessageNode>>printOn:indent:precedence: (in category 'printing') ----- + printOn: strm indent: level precedence: outerPrecedence + + | parenthesize | + parenthesize := precedence > outerPrecedence + or: [outerPrecedence = 3 and: [precedence = 3 "both keywords"]]. + parenthesize + ifTrue: [strm nextPutAll: '('. + self printOn: strm indent: level. + strm nextPutAll: ')'] + ifFalse: [self printOn: strm indent: level]! Item was added: + ----- Method: MessageNode>>printParenReceiver:on:indent: (in category 'printing') ----- + printParenReceiver: rcvr on: aStream indent: level + + rcvr isBlockNode ifTrue: + [^rcvr printOn: aStream indent: level]. + aStream nextPut: $(. + rcvr printOn: aStream indent: level. + aStream nextPut: $) + ! Item was added: + ----- Method: MessageNode>>printReceiver:on:indent: (in category 'printing') ----- + printReceiver: rcvr on: aStream indent: level + + rcvr ifNil: [^ self]. + + "Force parens around keyword receiver of kwd message" + rcvr printOn: aStream indent: level precedence: precedence! Item was added: + ----- Method: MessageNode>>printRepeatOn:indent: (in category 'printing') ----- + printRepeatOn: aStream indent: level + + self printReceiver: receiver on: aStream indent: level. + + ^self printKeywords: selector key + arguments: (Array new) + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>printToDoOn:indent: (in category 'printing') ----- + printToDoOn: aStream indent: level + + | limitNode | + self printReceiver: receiver on: aStream indent: level. + + (arguments last == nil or: [(arguments last isMemberOf: AssignmentNode) not]) + ifTrue: [limitNode := arguments first] + ifFalse: [limitNode := arguments last value]. + (selector key = #to:by:do: + and: [(arguments at: 2) isConstantNumber + and: [(arguments at: 2) key = 1]]) + ifTrue: [self printKeywords: #to:do: + arguments: (Array with: limitNode with: (arguments at: 3)) + on: aStream indent: level] + ifFalse: [self printKeywords: selector key + arguments: (Array with: limitNode) , arguments allButFirst + on: aStream indent: level]! Item was added: + ----- Method: MessageNode>>printWhileOn:indent: (in category 'printing') ----- + printWhileOn: aStream indent: level + self printReceiver: receiver on: aStream indent: level. + self + printKeywords: originalSelector + arguments: originalArguments + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisCaseOn:indent: (in category 'printing') ----- + printWithClosureAnalysisCaseOn: aStream indent: level + "receiver caseOf: {[key]->[value]. ...} otherwise: [otherwise]" + | braceNode otherwise extra | + braceNode := arguments first. + otherwise := arguments last. + (arguments size = 1 or: [otherwise isJustCaseError]) ifTrue: + [otherwise := nil]. + receiver + printWithClosureAnalysisOn: aStream + indent: level + precedence: 3. + aStream nextPutAll: ' caseOf: '. + braceNode isVariableReference + ifTrue: [braceNode printWithClosureAnalysisOn: aStream indent: level] + ifFalse: + [aStream nextPutAll: '{'; crtab: level + 1. + braceNode casesForwardDo: + [:keyNode :valueNode :last | + keyNode printWithClosureAnalysisOn: aStream indent: level + 1. + aStream nextPutAll: ' -> '. + valueNode isComplex + ifTrue: + [aStream crtab: level + 2. + extra := 1] + ifFalse: [extra := 0]. + valueNode printWithClosureAnalysisOn: aStream indent: level + 1 + extra. + last ifTrue: [aStream nextPut: $}] + ifFalse: [aStream nextPut: $.; + crtab: level + 1]]]. + otherwise notNil ifTrue: + [aStream crtab: level + 1; nextPutAll: ' otherwise: '. + extra := otherwise isComplex + ifTrue: + [aStream crtab: level + 2. + 1] + ifFalse: [0]. + otherwise printWithClosureAnalysisOn: aStream indent: level + 1 + extra]! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisIfNil:indent: (in category 'printing') ----- + printWithClosureAnalysisIfNil: aStream indent: level + + self printWithClosureAnalysisReceiver: receiver on: aStream indent: level. + + ^self printWithClosureAnalysisKeywords: selector key + arguments: (Array with: arguments first) + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisIfNilNotNil:indent: (in category 'printing') ----- + printWithClosureAnalysisIfNilNotNil: aStream indent: level + + (arguments first isJust: NodeNil) ifTrue: + [self printWithClosureAnalysisReceiver: receiver ifNilReceiver ifNilValue on: aStream indent: level. + ^ self + printWithClosureAnalysisKeywords: #ifNotNil: + arguments: { arguments second } + on: aStream indent: level]. + + (arguments second isJust: NodeNil) ifTrue: + [self printWithClosureAnalysisReceiver: receiver ifNilReceiver on: aStream indent: level. + ^ self + printWithClosureAnalysisKeywords: #ifNil: + arguments: { arguments first } + on: aStream indent: level]. + + self printWithClosureAnalysisReceiver: receiver ifNilReceiver ifNilValue on: aStream indent: level. + ^ self + printWithClosureAnalysisKeywords: #ifNil:ifNotNil: + arguments: arguments + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisIfOn:indent: (in category 'printing') ----- + printWithClosureAnalysisIfOn: aStream indent: level + + receiver ifNotNil: + [receiver printWithClosureAnalysisOn: aStream indent: level + 1 precedence: precedence]. + (arguments last isJust: NodeNil) ifTrue: + [^self printWithClosureAnalysisKeywords: #ifTrue: arguments: (Array with: arguments first) + on: aStream indent: level]. + (arguments last isJust: NodeFalse) ifTrue: + [^self printWithClosureAnalysisKeywords: #and: arguments: (Array with: arguments first) + on: aStream indent: level]. + (arguments first isJust: NodeNil) ifTrue: + [^self printWithClosureAnalysisKeywords: #ifFalse: arguments: (Array with: arguments last) + on: aStream indent: level]. + (arguments first isJust: NodeTrue) ifTrue: + [^self printWithClosureAnalysisKeywords: #or: arguments: (Array with: arguments last) + on: aStream indent: level]. + self printWithClosureAnalysisKeywords: #ifTrue:ifFalse: arguments: arguments + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisKeywords:arguments:on:indent: (in category 'printing') ----- + printWithClosureAnalysisKeywords: key arguments: args on: aStream indent: level + | keywords indent arg kwd doCrTab | + args size = 0 ifTrue: [aStream space; nextPutAll: key. ^self]. + keywords := key keywords. + doCrTab := args size > 2 + or: [{receiver} , args anySatisfy: + [:thisArg | + thisArg isBlockNode + or: [thisArg isMessageNode and: [thisArg precedence >= 3]]]]. + 1 to: (args size min: keywords size) do: + [:i | + arg := args at: i. + kwd := keywords at: i. + doCrTab + ifTrue: [aStream crtab: level+1. indent := 1] "newline after big args" + ifFalse: [aStream space. indent := 0]. + aStream nextPutAll: kwd; space. + arg printWithClosureAnalysisOn: aStream + indent: level + 1 + indent + precedence: (precedence = 2 ifTrue: [1] ifFalse: [precedence])]! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + "may not need this check anymore - may be fixed by the #receiver: change" + <hasLiteralTest: #isMacroPrinter:> + + special ifNil: [^aStream nextPutAll: '** MessageNode with nil special **']. + + special > 0 ifTrue: + [^self perform: self macroPrinter with: aStream with: level]. + + self printWithClosureAnalysisReceiver: receiver on: aStream indent: level. + self printWithClosureAnalysisKeywords: selector key + arguments: arguments + on: aStream + indent: level! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisOn:indent:precedence: (in category 'printing') ----- + printWithClosureAnalysisOn: strm indent: level precedence: outerPrecedence + + | parenthesize | + parenthesize := precedence > outerPrecedence + or: [outerPrecedence = 3 and: [precedence = 3 "both keywords"]]. + parenthesize + ifTrue: [strm nextPutAll: '('. + self printWithClosureAnalysisOn: strm indent: level. + strm nextPutAll: ')'] + ifFalse: [self printWithClosureAnalysisOn: strm indent: level]! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisParenReceiver:on:indent: (in category 'printing') ----- + printWithClosureAnalysisParenReceiver: rcvr on: aStream indent: level + + rcvr isBlockNode ifTrue: + [^rcvr printWithClosureAnalysisOn: aStream indent: level]. + aStream nextPut: $(. + rcvr printWithClosureAnalysisOn: aStream indent: level. + aStream nextPut: $)! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisReceiver:on:indent: (in category 'printing') ----- + printWithClosureAnalysisReceiver: rcvr on: aStream indent: level + + rcvr ifNil: [^self]. + + "Force parens around keyword receiver of kwd message" + rcvr printWithClosureAnalysisOn: aStream indent: level precedence: precedence! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisToDoOn:indent: (in category 'printing') ----- + printWithClosureAnalysisToDoOn: aStream indent: level + + | limitNode | + self printWithClosureAnalysisReceiver: receiver on: aStream indent: level. + + limitNode := (arguments last == nil + or: [arguments last isAssignmentNode not]) + ifTrue: [arguments first] + ifFalse: [arguments last value]. + (selector key = #to:by:do: + and: [(arguments at: 2) isConstantNumber + and: [(arguments at: 2) key = 1]]) + ifTrue: [self printWithClosureAnalysisKeywords: #to:do: + arguments: (Array with: limitNode with: (arguments at: 3)) + on: aStream indent: level] + ifFalse: [self printWithClosureAnalysisKeywords: selector key + arguments: (Array with: limitNode) , arguments allButFirst + on: aStream indent: level]! Item was added: + ----- Method: MessageNode>>printWithClosureAnalysisWhileOn:indent: (in category 'printing') ----- + printWithClosureAnalysisWhileOn: aStream indent: level + + self printWithClosureAnalysisReceiver: receiver on: aStream indent: level. + (arguments isEmpty not + and: [arguments first isJust: NodeNil]) ifTrue: + [selector := SelectorNode new + key: + (selector key == #whileTrue: + ifTrue: [#whileTrue] + ifFalse: [#whileFalse]) + code: #macro. + arguments := Array new]. + self printWithClosureAnalysisKeywords: selector key arguments: arguments + on: aStream indent: level! Item was added: + ----- Method: MessageNode>>pvtCheckForPvtSelector: (in category 'private') ----- + pvtCheckForPvtSelector: encoder + "If the code being compiled is trying to send a private message (e.g. 'pvtCheckForPvtSelector:') to anyone other than self, then complain to encoder." + + selector isPvtSelector ifTrue: + [receiver isSelfPseudoVariable ifFalse: + [encoder notify: 'Private messages may only be sent to self']].! Item was added: + ----- Method: MessageNode>>receiver (in category 'equation translation') ----- + receiver + ^receiver! Item was added: + ----- Method: MessageNode>>receiver: (in category 'equation translation') ----- + receiver: val + "14 feb 2001 - removed return arrow" + + receiver := val! Item was added: + ----- Method: MessageNode>>receiver:arguments:precedence: (in category 'private') ----- + receiver: rcvr arguments: args precedence: p + + receiver := rcvr. + originalReceiver := rcvr. + arguments := args. + originalArguments := arguments copy. + sizes := Array new: arguments size. + precedence := p! Item was added: + ----- Method: MessageNode>>receiver:selector:arguments:precedence: (in category 'initialize-release') ----- + receiver: rcvr selector: selNode arguments: args precedence: p + "Decompile." + + self receiver: rcvr + arguments: args + precedence: p. + originalSelector := selNode key. + selNode code == #macro + ifTrue: [self noteSpecialSelector: selNode key] + ifFalse: [special := 0]. + selector := selNode. + "self pvtCheckForPvtSelector: encoder" + "We could test code being decompiled, but the compiler should've checked already. And where to send the complaint?"! Item was added: + ----- Method: MessageNode>>receiver:selector:arguments:precedence:from: (in category 'initialize-release') ----- + receiver: rcvr selector: aSelector arguments: args precedence: p from: encoder + "Compile." + + self receiver: rcvr + arguments: args + precedence: p. + originalSelector := aSelector. + self noteSpecialSelector: aSelector. + (self transform: encoder) + ifTrue: + [selector isNil ifTrue: + [selector := SelectorNode new + key: (MacroSelectors at: special) + code: #macro]] + ifFalse: + [selector := encoder encodeSelector: aSelector. + rcvr == NodeSuper ifTrue: [encoder noteSuper]]. + self pvtCheckForPvtSelector: encoder! Item was added: + ----- Method: MessageNode>>receiver:selector:arguments:precedence:from:sourceRange: (in category 'initialize-release') ----- + receiver: rcvr selector: selName arguments: args precedence: p from: encoder sourceRange: range + "Compile." + ((selName == #future) or:[selName == #future:]) ifTrue: + [Smalltalk at: #FutureNode ifPresent: + [:futureNode| + ^futureNode new + receiver: rcvr + selector: selName + arguments: args + precedence: p + from: encoder + sourceRange: range]]. + (rcvr isFutureNode + and: [rcvr futureSelector == nil]) ifTrue: + "Transform regular message into future" + [^rcvr futureMessage: selName + arguments: args + from: encoder + sourceRange: range]. + + encoder noteSourceRange: range forNode: self. + ^self + receiver: rcvr + selector: selName + arguments: args + precedence: p + from: encoder! Item was added: + ----- Method: MessageNode>>selector (in category 'equation translation') ----- + selector + ^selector! Item was added: + ----- Method: MessageNode>>selector: (in category 'initialize-release') ----- + selector: sel + selector := sel! Item was added: + ----- Method: MessageNode>>sizeCodeForCase:value: (in category 'code generation') ----- + sizeCodeForCase: encoder value: forValue + + | braceNode sizeIndex elseSize allReturn | + forValue not ifTrue: + [^super sizeCodeForEffect: encoder]. + equalNode := encoder encodeSelector: #=. + braceNode := arguments first. + sizes := Array new: 2 * braceNode numElements. + sizeIndex := sizes size. + elseSize := arguments size = 2 + ifTrue: + [arguments last sizeCodeForEvaluatedValue: encoder] "otherwise: [...]" + ifFalse: + [caseErrorNode := encoder encodeSelector: #caseError. + "Assume that the receiver of caseOf: has been dup" + (caseErrorNode sizeCode: encoder args: 0 super: false)]. "self caseError" + "There must be at least one branch around the otherwise/caseError + so the decompiler can identify the end of the otherwise/caseError." + allReturn := true. "assume every case ends with a return" + braceNode casesForwardDo: + [:keyNode :valueNode :last | + valueNode returns ifFalse: [allReturn := false]]. + braceNode casesReverseDo: + [:keyNode :valueNode :last | + | thenSize dropReceiver | + dropReceiver := last and: [arguments size >= 2]. + sizes at: sizeIndex put: elseSize. + thenSize := valueNode sizeCodeForEvaluatedValue: encoder. + dropReceiver ifFalse: [thenSize := thenSize + encoder sizePop]. + valueNode returns ifFalse: [thenSize := thenSize + (self sizeCode: encoder forJump: elseSize)]. + (last and: [allReturn]) ifTrue: [thenSize := thenSize + (self sizeCode: encoder forJump: elseSize)]. + sizes at: sizeIndex-1 put: thenSize. + dropReceiver ifFalse: [elseSize := elseSize + encoder sizeDup]. + elseSize := elseSize + + (keyNode sizeCodeForEvaluatedValue: encoder) + + (equalNode sizeCode: encoder args: 1 super: false) + + (self sizeCode: encoder forBranchOn: false dist: thenSize) + + thenSize. + sizeIndex := sizeIndex - 2]. + ^(receiver sizeCodeForValue: encoder) + elseSize! Item was added: + ----- Method: MessageNode>>sizeCodeForEffect: (in category 'code generation') ----- + sizeCodeForEffect: encoder + <hasLiteralTest: #isMacroSizer:> + + special > 0 + ifTrue: + [encoder noteOptimizedSelector: originalSelector. + ^self perform: (MacroSizers at: special) with: encoder with: false]. + ^super sizeCodeForEffect: encoder! Item was added: + ----- Method: MessageNode>>sizeCodeForIf:value: (in category 'code generation') ----- + sizeCodeForIf: encoder value: forValue + | thenExpr elseExpr branchSize thenSize elseSize popSize requireTwoArms | + thenExpr := arguments at: 1. + elseExpr := arguments at: 2. + popSize := 0. + requireTwoArms := forValue or: [ "Code all forValue as two-armed" + arguments noneSatisfy: [:expr | expr isJust: NodeNil]]. + requireTwoArms + ifTrue: + [elseSize := elseExpr sizeCodeForEvaluatedValue: encoder. + thenSize := (thenExpr sizeCodeForEvaluatedValue: encoder) + + (thenExpr returns + ifTrue: [0] "Elide jump over else after a return" + ifFalse: [self sizeCode: encoder forJump: elseSize]). + branchSize := self sizeCode: encoder forBranchOn: false dist: thenSize. + "Two-armed IFs forEffect share a single pop - except if both branches return" + forValue ifFalse: [(arguments allSatisfy: #returns) ifFalse: [popSize := encoder sizePop]]] + ifFalse: "One arm is empty here (two-arms code forValue)" + [(elseExpr isJust: NodeNil) + ifTrue: + [elseSize := 0. + thenSize := thenExpr sizeCodeForEvaluatedEffect: encoder. + branchSize := self sizeCode: encoder forBranchOn: false dist: thenSize] + ifFalse: + [thenSize := 0. + elseSize := elseExpr sizeCodeForEvaluatedEffect: encoder. + branchSize := self sizeCode: encoder forBranchOn: true dist: elseSize]]. + sizes := Array with: thenSize with: elseSize. + ^(receiver sizeCodeForValue: encoder) + + branchSize + thenSize + elseSize + popSize! Item was added: + ----- Method: MessageNode>>sizeCodeForIfNil:value: (in category 'code generation') ----- + sizeCodeForIfNil: encoder value: forValue + + | theNode theSize theSelector | + equalNode := encoder encodeSelector: #==. + sizes := Array new: 1. + theNode := arguments first. + theSelector := #ifNotNil:. + forValue + ifTrue: + [sizes at: 1 put: (theSize := (encoder sizePop + (theNode sizeCodeForEvaluatedValue: encoder))). + ^(receiver sizeCodeForValue: encoder) + + encoder sizeDup + + (encoder sizePushSpecialLiteral: nil) + + (equalNode sizeCode: encoder args: 1 super: false) + + (self + sizeCode: encoder forBranchOn: selector key == theSelector + dist: theSize) + + theSize] + ifFalse: + [sizes at: 1 put: (theSize := (theNode sizeCodeForEvaluatedEffect: encoder)). + ^(receiver sizeCodeForValue: encoder) + + (encoder sizePushSpecialLiteral: nil) + + (equalNode sizeCode: encoder args: 1 super: false) + + (self + sizeCode: encoder + forBranchOn: selector key == theSelector + dist: theSize) + + theSize]! Item was added: + ----- Method: MessageNode>>sizeCodeForRepeat:value: (in category 'code generation') ----- + sizeCodeForRepeat: encoder value: forValue + "L1: ... Jmp(L1) nil (nil for value only);" + | loopSize | + "We assume long backward branches are always maximal size branches." + loopSize := (receiver sizeCodeForEvaluatedEffect: encoder) + (encoder sizeJumpLong: -1). + sizes := Array with: loopSize. + ^loopSize + (forValue ifTrue: [encoder sizePushSpecialLiteral: nil] ifFalse: [0])! Item was added: + ----- Method: MessageNode>>sizeCodeForToDo:value: (in category 'code generation') ----- + sizeCodeForToDo: encoder value: forValue + " var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] Jmp(L1) L2: " + | loopSize initStmt test block incStmt blockSize initSize limitInit | + block := arguments at: 3. + initStmt := arguments at: 4. + test := arguments at: 5. + incStmt := arguments at: 6. + limitInit := arguments at: 7. + initSize := forValue + ifTrue: [initStmt sizeCodeForValue: encoder.] + ifFalse: [initStmt sizeCodeForEffect: encoder]. + limitInit == nil ifFalse: + [initSize := initSize + (limitInit sizeCodeForEffect: encoder)]. + blockSize := (block sizeCodeForEvaluatedEffect: encoder) + + (incStmt sizeCodeForEffect: encoder) + + (encoder sizeJumpLong: -1). + loopSize := (test sizeCodeForValue: encoder) + + (self sizeCode: encoder forBranchOn: false dist: blockSize) + + blockSize. + sizes := Array with: blockSize with: loopSize. + ^initSize + + loopSize! Item was added: + ----- Method: MessageNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + <hasLiteralTest: #isMacroSizer:> + | total | + special > 0 ifTrue: + [encoder noteOptimizedSelector: originalSelector. + ^self perform: (MacroSizers at: special) with: encoder with: true]. + receiver == NodeSuper ifTrue: + [selector := selector forSuperSend "only necessary for special selectors"]. + total := selector sizeCode: encoder args: arguments size super: receiver == NodeSuper. + receiver ifNotNil: + [total := total + (receiver sizeCodeForValue: encoder)]. + sizes := arguments collect: + [:arg | | argSize | + argSize := arg sizeCodeForValue: encoder. + total := total + argSize. + argSize]. + ^total! Item was added: + ----- Method: MessageNode>>sizeCodeForWhile:value: (in category 'code generation') ----- + sizeCodeForWhile: encoder value: forValue + "L1: ... Bfp(L2) ... Jmp(L1) L2: nil (nil for value only); + justStmt, wholeLoop, justJump." + | cond stmt stmtSize loopSize branchSize | + cond := receiver. + stmt := arguments at: 1. + "We assume long backward branches are always maximal size branches." + stmtSize := (stmt sizeCodeForEvaluatedEffect: encoder) + (encoder sizeJumpLong: -1). + branchSize := self + sizeCode: encoder + forBranchOn: selector key == #whileFalse: "Btp for whileFalse" + dist: stmtSize. + loopSize := (cond sizeCodeForEvaluatedValue: encoder) + branchSize + stmtSize. + sizes := Array with: stmtSize with: loopSize. + ^loopSize + (forValue ifTrue: [encoder sizePushSpecialLiteral: nil] ifFalse: [0])! Item was added: + ----- Method: MessageNode>>test (in category 'printing') ----- + test + + 3 > 4 ifTrue: [4+5 between: 6 and: 7] + ifFalse: [4 between: 6+5 and: 7-2]! Item was added: + ----- Method: MessageNode>>toDoFromWhileWithCounts:init:limit: (in category 'decompiling') ----- + toDoFromWhileWithCounts: blockBodyTempCounts init: incrInit limit: limitInitOrNil + "If the receiver, a whileTrue: loop, represents a to:[by:]do: loop + then answer the replacement to:[by:]do:, otherwise answer nil." + | variable increment limit toDoBlock body test | + self assert: (selector key == #whileTrue: + and: [incrInit isAssignmentNode]). + (limitInitOrNil notNil "limit should not be referenced within the loop" + and: [(blockBodyTempCounts at: limitInitOrNil variable ifAbsent: [0]) ~= 1]) ifTrue: + [^nil]. + body := arguments last statements. + (variable := incrInit variable) isTemp ifFalse: + [^nil]. + (increment := body last toDoIncrement: variable) ifNil: + [^nil]. + receiver statements size ~= 1 ifTrue: + [^nil]. + test := receiver statements first. + "Note: test should really be checked that <= or >= comparison + jibes with the sign of the (constant) increment" + (test isMessageNode + and: [(limit := test toDoLimit: variable) notNil]) ifFalse: + [^nil]. + "The block must not overwrite the limit" + (limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]]) ifTrue: + [^nil]. + toDoBlock := BlockNode statements: body allButLast returns: false. + toDoBlock arguments: {variable}. + ^MessageNode new + receiver: incrInit value + selector: (SelectorNode new key: #to:by:do: code: #macro) + arguments: (Array with: limit with: increment with: toDoBlock) + precedence: precedence! Item was added: + ----- Method: MessageNode>>toDoFromWhileWithInit:withLimit: (in category 'decompiling') ----- + toDoFromWhileWithInit: incrInit withLimit: limitInitOrNil + "If the receiver, a whileTrue: loop, represents a to:[by:]do: loop + then answer the replacement to:[by:]do:, otherwise answer nil." + | variable increment limit toDoBlock body test | + self assert: (selector key == #whileTrue: + and: [incrInit isAssignmentNode]). + body := arguments last statements. + (variable := incrInit variable) isTemp ifFalse: + [^nil]. + (increment := body last toDoIncrement: variable) ifNil: + [^nil]. + receiver statements size ~= 1 ifTrue: + [^nil]. + test := receiver statements first. + "Note: test should really be checked that <= or >= comparison + jibes with the sign of the (constant) increment" + (test isMessageNode + and: [(limit := test toDoLimit: variable) notNil]) ifFalse: + [^nil]. + "The block must not overwrite the limit" + (limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]]) ifTrue: + [^nil]. + toDoBlock := BlockNode statements: body allButLast returns: false. + toDoBlock arguments: {variable}. + ^MessageNode new + receiver: incrInit value + selector: (SelectorNode new key: #to:by:do: code: #macro) + arguments: (Array with: limit with: increment with: toDoBlock) + precedence: precedence! Item was added: + ----- Method: MessageNode>>toDoIncrement: (in category 'testing') ----- + toDoIncrement: variable + ^(receiver = variable + and: [selector key = #+ + and: [arguments first isConstantNumber]]) ifTrue: + [arguments first]! Item was added: + ----- Method: MessageNode>>toDoLimit: (in category 'testing') ----- + toDoLimit: variable + ^(receiver = variable + and: [selector key = #<= or: [selector key = #>=]]) ifTrue: + [arguments first]! Item was added: + ----- Method: MessageNode>>transform: (in category 'macro transformations') ----- + transform: encoder + <hasLiteralTest: #isMacroTransformer:> + + special = 0 ifTrue: [^false]. + (self perform: (MacroTransformers at: special) with: encoder) + ifTrue: + [^true] + ifFalse: + [special := 0. ^false]! Item was added: + ----- Method: MessageNode>>transformAnd: (in category 'macro transformations') ----- + transformAnd: encoder + (self transformBoolean: encoder) + ifTrue: + [arguments := + Array + with: ((arguments at: 1) noteOptimizedIn: self) + with: ((BlockNode withJust: NodeFalse) noteOptimizedIn: self). + ^true] + ifFalse: + [^false]! Item was added: + ----- Method: MessageNode>>transformBoolean: (in category 'macro transformations') ----- + transformBoolean: encoder + ^self + checkBlock: (arguments at: 1) + as: 'argument' + from: encoder + maxArgs: 0! Item was added: + ----- Method: MessageNode>>transformCase: (in category 'macro transformations') ----- + transformCase: encoder + + | caseNode | + caseNode := arguments first. + (caseNode isMemberOf: BraceNode) ifFalse: [^false]. + (caseNode blockAssociationCheck: encoder) ifFalse: [^false]. + (arguments size = 1 + or: [self checkBlock: arguments last as: 'otherwise arg' from: encoder maxArgs: 1]) ifFalse: + [^false]. + caseNode elements do: + [:messageNode | + messageNode receiver noteOptimizedIn: self. + messageNode arguments first noteOptimizedIn: self]. + arguments size = 2 ifTrue: + [| otherwiseBlock | + otherwiseBlock := arguments last noteOptimizedIn: self. + otherwiseBlock numberOfArguments = 1 ifTrue: + [receiver := AssignmentNode new + variable: otherwiseBlock firstArgument + value: receiver. + encoder noteSourceRange: (encoder sourceRangeFor: self) forNode: receiver]]. + ^true! Item was added: + ----- Method: MessageNode>>transformIfFalse: (in category 'macro transformations') ----- + transformIfFalse: encoder + (self transformBoolean: encoder) + ifTrue: + [arguments := + Array + with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self) + with: ((arguments at: 1) noteOptimizedIn: self). + ^true] + ifFalse: + [^false]! Item was added: + ----- Method: MessageNode>>transformIfFalseIfTrue: (in category 'macro transformations') ----- + transformIfFalseIfTrue: encoder + ^(self checkBlock: (arguments at: 1) as: 'False arg' from: encoder maxArgs: 0) + and: [(self checkBlock: (arguments at: 2) as: 'True arg' from: encoder maxArgs: 0) + and: [selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro. + arguments swap: 1 with: 2. + arguments do: [:arg| arg noteOptimizedIn: self]. + true]]! Item was added: + ----- Method: MessageNode>>transformIfNil: (in category 'macro transformations') ----- + transformIfNil: encoder + + "vb: Removed the original transformBoolean: which amounds to a test we perform in each of the branches below." + (MacroSelectors at: special) = #ifNotNil: ifTrue: + [(self checkBlock: arguments first as: 'ifNotNil arg' from: encoder maxArgs: 1) ifFalse: + [^false]. + + "Transform 'ifNotNil: [stuff]' to 'ifNil: [nil] ifNotNil: [stuff]'. + Slightly better code and more consistent with decompilation." + self noteSpecialSelector: #ifNil:ifNotNil:. + selector := SelectorNode new key: (MacroSelectors at: special) code: #macro. + arguments := Array + with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self) + with: (arguments first noteOptimizedIn: self). + (self transform: encoder) ifFalse: + [self error: 'compiler logic error']. + ^true]. + (self checkBlock: arguments first as: 'ifNil arg' from: encoder maxArgs: 0) ifFalse: + [^false]. + arguments first noteOptimizedIn: self. + ^true! Item was added: + ----- Method: MessageNode>>transformIfNilIfNotNil: (in category 'macro transformations') ----- + transformIfNilIfNotNil: encoder + "vb: Changed to support one-argument ifNotNil: branch. In the 1-arg case we + transform the receiver to + (var := receiver) + which is further transformed to + (var := receiver) == nil ifTrue: .... ifFalse: ... + This does not allow the block variable to shadow an existing temp, but it's no different + from how to:do: is done." + | ifNotNilArg | + ifNotNilArg := arguments at: 2. + ((self checkBlock: (arguments at: 1) as: 'Nil arg' from: encoder maxArgs: 0) + and: [self checkBlock: ifNotNilArg as: 'NotNil arg' from: encoder maxArgs: 1]) ifFalse: + [^false]. + + ifNotNilArg numberOfArguments = 1 ifTrue: + [receiver := AssignmentNode new + variable: ifNotNilArg firstArgument + value: receiver. + encoder noteSourceRange: (encoder sourceRangeFor: self) forNode: receiver]. + + selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro. + receiver := MessageNode new + receiver: receiver + selector: #== + arguments: (Array with: NodeNil) + precedence: 2 + from: encoder. + encoder noteSourceRange: (encoder sourceRangeFor: self) forNode: receiver. + arguments do: [:arg| arg noteOptimizedIn: self]. + ^true! Item was added: + ----- Method: MessageNode>>transformIfNotNilIfNil: (in category 'macro transformations') ----- + transformIfNotNilIfNil: encoder + "vb: Changed to support one-argument ifNotNil: branch. In the 1-arg case we + transform the receiver to + (var := receiver) + which is further transformed to + (var := receiver) == nil ifTrue: .... ifFalse: ... + This does not allow the block variable to shadow an existing temp, but it's no different + from how to:do: is done." + | ifNotNilArg | + ifNotNilArg := arguments at: 1. + ((self checkBlock: ifNotNilArg as: 'NotNil arg' from: encoder maxArgs: 1) + and: [self checkBlock: (arguments at: 2) as: 'Nil arg' from: encoder maxArgs: 0]) ifFalse: + [^false]. + + ifNotNilArg numberOfArguments = 1 ifTrue: + [receiver := AssignmentNode new + variable: ifNotNilArg firstArgument + value: receiver. + encoder noteSourceRange: (encoder sourceRangeFor: self) forNode: receiver]. + + selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro. + receiver := MessageNode new + receiver: receiver + selector: #== + arguments: (Array with: NodeNil) + precedence: 2 + from: encoder. + encoder noteSourceRange: (encoder sourceRangeFor: self) forNode: receiver. + arguments swap: 1 with: 2. + arguments do: [:arg| arg noteOptimizedIn: self]. + ^true! Item was added: + ----- Method: MessageNode>>transformIfTrue: (in category 'macro transformations') ----- + transformIfTrue: encoder + (self transformBoolean: encoder) + ifTrue: + [arguments := + Array + with: ((arguments at: 1) noteOptimizedIn: self) + with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self). + ^true] + ifFalse: + [^false]! Item was added: + ----- Method: MessageNode>>transformIfTrueIfFalse: (in category 'macro transformations') ----- + transformIfTrueIfFalse: encoder + ^(self checkBlock: (arguments at: 1) as: 'True arg' from: encoder maxArgs: 0) + and: [(self checkBlock: (arguments at: 2) as: 'False arg' from: encoder maxArgs: 0) + and: [arguments do: [:arg| arg noteOptimizedIn: self]. + true]]! Item was added: + ----- Method: MessageNode>>transformOr: (in category 'macro transformations') ----- + transformOr: encoder + (self transformBoolean: encoder) + ifTrue: + [arguments := + Array + with: ((BlockNode withJust: NodeTrue) noteOptimizedIn: self) + with: ((arguments at: 1) noteOptimizedIn: self). + ^true] + ifFalse: + [^false]! Item was added: + ----- Method: MessageNode>>transformRepeat: (in category 'macro transformations') ----- + transformRepeat: encoder + "answer true if this #repeat message can be optimized" + + ^(self checkBlock: receiver as: 'receiver' from: encoder maxArgs: 0) + and: [receiver noteOptimizedIn: self. + true]! Item was added: + ----- Method: MessageNode>>transformToDo: (in category 'macro transformations') ----- + transformToDo: encoder + " var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] Jmp(L1) L2: " + | limit increment block initStmt test incStmt limitInit blockVar myRange blockRange | + block := arguments last. + "First check for valid arguments" + (block notNil + and: [block isBlockNode + and: [block numberOfArguments = 1 + and: [block firstArgument isVariableReference "As with debugger remote vars"]]]) ifFalse: + [^false]. + arguments size = 3 + ifTrue: [increment := arguments at: 2. + (increment isConstantNumber + and: [increment literalValue ~= 0]) ifFalse: [^false]] + ifFalse: [increment := encoder encodeLiteral: 1]. + (limit := arguments at: 1) isVariableReference ifTrue: + [| shouldScanForAssignment | + shouldScanForAssignment := limit isArg not + or: [limit isBlockArg and: [Scanner allowBlockArgumentAssignment]]. + shouldScanForAssignment ifTrue: + [block nodesDo: + [:node| + (node isAssignmentNode and: [node variable = limit]) ifTrue: + [^false]]]]. + arguments size < 3 ifTrue: "transform to full form" + [selector := SelectorNode new key: #to:by:do: code: #macro]. + + "Now generate auxiliary structures" + myRange := encoder rawSourceRanges at: self ifAbsent: [1 to: 0]. + blockRange := encoder rawSourceRanges at: block ifAbsent: [1 to: 0]. + blockVar := block firstArgument. + initStmt := AssignmentNode new variable: blockVar value: receiver. + (limit isVariableReference or: [limit isConstantNumber]) + ifTrue: [limitInit := nil] + ifFalse: "Need to store limit in a var" + [limit := encoder bindBlockArg: blockVar key, 'LimiT' within: block. + limit scope: -2. "Already done parsing block; flag so it won't print" + block addArgument: limit. + limitInit := AssignmentNode new + variable: limit + value: arguments first]. + test := MessageNode new + receiver: blockVar + selector: (increment key > 0 ifTrue: [#<=] ifFalse: [#>=]) + arguments: {limit} + precedence: precedence + from: encoder + sourceRange: (myRange first to: blockRange first). + incStmt := AssignmentNode new + variable: blockVar + value: (MessageNode new + receiver: blockVar selector: #+ + arguments: {increment} + precedence: precedence + from: encoder + sourceRange: (myRange last to: (myRange last max: blockRange last))) + from: encoder + sourceRange: (myRange last to: (myRange last max: blockRange last)). + arguments := {limit. increment. block. initStmt. test. incStmt. limitInit}. + block noteOptimizedIn: self. + ^true! Item was added: + ----- Method: MessageNode>>transformWhile: (in category 'macro transformations') ----- + transformWhile: encoder + (self checkBlock: receiver as: 'receiver' from: encoder maxArgs: 0) ifFalse: + [^false]. + arguments size = 0 ifTrue: "transform bodyless form to body form" + [selector := SelectorNode new + key: (special = 10 ifTrue: [#whileTrue:] ifFalse: [#whileFalse:]) + code: #macro. + arguments := Array with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self). + receiver noteOptimizedIn: self. + ^true]. + ^(self transformBoolean: encoder) + and: [receiver noteOptimizedIn: self. + arguments first noteOptimizedIn: self. + true]! Item was added: + ParseNode subclass: #MethodNode + instanceVariableNames: 'selectorOrFalse precedence arguments block primitive encoder temporaries properties sourceText locationCounter localsPool' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !MethodNode commentStamp: 'eem 8/15/2010 10:49' prior: 0! + I am the root of the parse tree.. + + Instance Variables + arguments: <SequenceableCollection> + block: <BlockNode> + encoder: <BytecodeEncoder> + localsPool: <IdentitySet> + locationCounter: <Integer> + precedence: <Integer> + primitive: <Integer> + properties: <AdditionalMethodState|nil> + selectorOrFalse: <Object> + sourceText: <String|Text> + temporaries: <SequenceableCollection> + + arguments + - the collection of parsed or decompiled method arguments + + block + - the BlockNode holding the method's statements + + encoder + - the object that comprises the copiler's scope table, literal pool and back-end bytecode generator + + localsPool + - a set used to determine the set of copied values for each block in the method + + locationCounter + - an integer used to mark block scopes for the purposes of the closure transformation. See BlockNode>>#analyseArguments:temporaries:rootNode: + + precedence + - the precedence of the method's selector (see Symbol>>precedence) + + primitive + - if non-zero this is the integer code of the method's primitive + + properties + - the object used to accumulate method properties (a.k.a. pragmas) + + selectorOrFalse + - the method's selector or false if this is a doit + + sourceText + - the source test from which the method was compiled + + temporaries + - the collection of parsed or decompiled method temporaries + ! Item was added: + ----- Method: MethodNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitMethodNode: self! Item was added: + ----- Method: MethodNode>>addLocalsToPool: (in category 'closure analysis') ----- + addLocalsToPool: locals "<Set of: TempVariableNode>" + localsPool isNil ifTrue: + [localsPool := IdentitySet new]. + localsPool addAll: locals! Item was added: + ----- Method: MethodNode>>arguments (in category 'accessing') ----- + arguments + "For transformations etc, not used in compilation" + ^arguments! Item was added: + ----- Method: MethodNode>>arguments: (in category 'accessing') ----- + arguments: aSequence + "For transformations etc, not used in compilation" + arguments := aSequence! Item was added: + ----- Method: MethodNode>>asColorizedSmalltalk80Text (in category 'converting') ----- + asColorizedSmalltalk80Text + "Answer a colorized Smalltalk-80-syntax string description of the parse tree whose root is the receiver." + + | printText | + printText := self printString asText. + ^(TextStyler for: #Smalltalk) + ifNotNil: [:stylerClass| stylerClass new styledTextFor: printText] + ifNil: [printText]! Item was added: + ----- Method: MethodNode>>block (in category 'initialize-release') ----- + block + ^ block! Item was added: + ----- Method: MethodNode>>blockExtentsToTempsMap (in category 'debugger support') ----- + blockExtentsToTempsMap + "Answer a Dictionary of blockExtent to temp locations for the current method. + This is used by the debugger to locate temp vars in contexts. A temp map + entry is a pair of the temp's name and its index, where an index is either an + integer for a normal temp or a pair of the index of the indirect temp vector + containing the temp and the index of the temp in its indirect temp vector." + + ^encoder blockExtentsToTempsMap ifNil: + [| methNode | + methNode := encoder classEncoding newParser + encoderClass: encoder class; + parse: (sourceText ifNil: [self decompileString]) + class: self methodClass. + "As a side effect generate: creates data needed for the map." + methNode generate. + methNode encoder blockExtentsToTempsMap]! Item was added: + ----- Method: MethodNode>>body (in category 'accessing') ----- + body + ^block! Item was added: + ----- Method: MethodNode>>decompileString (in category 'converting') ----- + decompileString + "Answer a string description of the parse tree whose root is the receiver." + + ^self fullPrintString + ! Item was added: + ----- Method: MethodNode>>decompileText (in category 'converting') ----- + decompileText + "Answer a string description of the parse tree whose root is the receiver." + + ^self asColorizedSmalltalk80Text! Item was added: + ----- Method: MethodNode>>encoder (in category 'code generation') ----- + encoder + ^ encoder! Item was added: + ----- Method: MethodNode>>ensureClosureAnalysisDone (in category 'closure analysis') ----- + ensureClosureAnalysisDone + block blockExtent ifNil: + [temporaries := block analyseArguments: arguments temporaries: temporaries rootNode: self]! Item was added: + ----- Method: MethodNode>>ensureNotQuick (in category 'converting') ----- + ensureNotQuick + "If the receiver is quick (can be generated as a Quick method, ^self,^inst var or ^ special constant) + make it not so. This is used to create break-pointable versions of quick methods. Answer if the + receiver was quick." + ^block ensureNotQuick: encoder! Item was added: + ----- Method: MethodNode>>generate (in category 'code generation') ----- + generate + "The receiver is the root of a parse tree. Answer a CompiledMethod. The + argument, trailer, is the references to the source code that is stored with + every CompiledMethod." + + ^self generate: CompiledMethodTrailer empty using: CompiledMethod! Item was added: + ----- Method: MethodNode>>generate: (in category 'code generation') ----- + generate: trailer + "The receiver is the root of a parse tree. Answer a CompiledMethod. + The argument, trailer, is arbitrary but is typically either the reference + to the source code that is stored with every CompiledMethod, or an + encoding of the method's temporary names." + + ^self generate: trailer using: CompiledMethod! Item was added: + ----- Method: MethodNode>>generate:ifQuick: (in category 'code generation') ----- + generate: trailer ifQuick: methodBlock + ^self generate: trailer using: CompiledMethod ifQuick: methodBlock! Item was added: + ----- Method: MethodNode>>generate:using: (in category 'code generation') ----- + generate: trailer using: aCompiledMethodClass + "The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass. + The argument, trailer, is arbitrary but is typically either the reference to the source code + that is stored with every CompiledMethod, or an encoding of the method's temporary names." + + | method | + self generate: trailer + using: aCompiledMethodClass + ifQuick: + [:m | + m literalAt: 2 put: encoder associationForClass; + properties: properties. + ^m]. + method := encoder generateMethodOfClass: aCompiledMethodClass trailer: trailer from: self. + method properties: properties. + ^method! Item was added: + ----- Method: MethodNode>>generate:using:ifQuick: (in category 'code generation') ----- + generate: trailer using: aCompiledMethodClass ifQuick: methodBlock + | v | + (primitive = 0 and: [arguments size = 0 and: [block isQuick]]) ifFalse: + [^self]. + v := block code. + v < 0 ifTrue: + [^self]. + v = LdSelf ifTrue: + [^methodBlock value: (aCompiledMethodClass toReturnSelfTrailerBytes: trailer)]. + (v between: LdTrue and: LdMinus1 + 3) ifTrue: + [^methodBlock value: (aCompiledMethodClass toReturnConstant: v - LdSelf trailerBytes: trailer)]. + v < ((CodeBases at: LdInstType) + (CodeLimits at: LdInstType)) ifTrue: + [^methodBlock value: (aCompiledMethodClass toReturnField: v trailerBytes: trailer)]. + v // 256 = 1 ifTrue: + [^methodBlock value: (aCompiledMethodClass toReturnField: v \\ 256 trailerBytes: trailer)]! Item was added: + ----- Method: MethodNode>>generateWithTempNames (in category 'code generation') ----- + generateWithTempNames + "Answer a CompiledMethod with temps names encoded in its trailer." + | methodSansTempNames | + "The encoder computes the schematic temp names during generation, so + generate a method without temp names first. If the method is quick there are + no temps and hence no temp names." + methodSansTempNames := self + generate: CompiledMethodTrailer empty + using: CompiledMethod. + ^methodSansTempNames + copyWithTrailerBytes: + ((CompiledMethodTrailer new tempNames: + (methodSansTempNames isQuick + ifTrue: [''] + ifFalse: [encoder schematicTempNamesString])))! Item was added: + ----- Method: MethodNode>>hasGeneratedMethod (in category 'debugger support') ----- + hasGeneratedMethod + ^encoder hasGeneratedMethod! Item was added: + ----- Method: MethodNode>>locationCounter (in category 'closure analysis') ----- + locationCounter + ^locationCounter! Item was added: + ----- Method: MethodNode>>methodClass (in category 'printing') ----- + methodClass + + ^ encoder classEncoding! Item was added: + ----- Method: MethodNode>>noteBlockEntry: (in category 'closure analysis') ----- + noteBlockEntry: aBlock + "Evaluate aBlock with the numbering for the block entry." + locationCounter isNil ifTrue: + [locationCounter := -1]. + aBlock value: locationCounter + 1. + locationCounter := locationCounter + 2! Item was added: + ----- Method: MethodNode>>noteBlockExit: (in category 'closure analysis') ----- + noteBlockExit: aBlock + "Evaluate aBlock with the numbering for the block exit." + aBlock value: locationCounter + 1. + locationCounter := locationCounter + 2! Item was added: + ----- Method: MethodNode>>parserClass (in category 'code generation') ----- + parserClass + "Which parser produces this class of parse node" + + ^ Parser! Item was added: + ----- Method: MethodNode>>preen (in category 'converting') ----- + preen + "Preen for pretty-printing and/or decompilation. + i.e. post-process to cover up for inadequacies in both algorithms. + + Currently two cases: + + preenLocalIfNotNilArg: blockNode + hiding the assignment to the arg of an inlined block arg to ifNotNil:, + (var := expr) ifNil: [...] ifNotNil: [...] => expr ifNil: [...] ifNotNil: [:var| ...]. + + preenTempsConflictingWithBlockNode: temps + hiding the declaration of a temp that is redeclared in some block" + + self preenableNodes keysAndValuesDo: + [:nodeOrArray :selector | + self perform: selector with: nodeOrArray]! Item was added: + ----- Method: MethodNode>>preenIfNotNilNode: (in category 'converting-private') ----- + preenIfNotNilNode: messageNode + "Transform a (var := expr) ifNil: [...] ifNotNil: [...] where var is only used in the ifNotNil: block + and convert it to expr ifNil: [...] ifNotNil: [:var| ...]. Deal both with the pretty-print case where + the block already declares the variable and the decompile case where it does not." + + | variable | + self assert: (messageNode isMessageNode + and: [messageNode macroPrinter == #printIfNilNotNil:indent: + and: [messageNode receiver receiver isAssignmentNode]]). + variable := messageNode receiver receiver variable. + self assert: (variable isTemp and: [variable isRemote not]). + messageNode arguments last arguments isEmpty + ifTrue: [messageNode arguments last arguments: { variable }] + ifFalse: + [self assert: messageNode arguments last arguments asArray = { variable }. + variable := nil]. + messageNode receiver receiver: messageNode receiver receiver value. + variable ifNil: [^self]. + self nodesDo: + [:node| + ((node == self or: [node isBlockNode]) + and: [node temporaries includes: variable]) ifTrue: + [node temporaries: (node temporaries copyWithout: variable)]]! Item was added: + ----- Method: MethodNode>>preenNilNodeFollowingNilIfNode: (in category 'converting-private') ----- + preenNilNodeFollowingNilIfNode: aNilIfMessageNode + self nodesDo: + [:node| | statements indices | + (node isBlockNode + and: [(statements := node statements) includes: aNilIfMessageNode]) ifTrue: + [indices := (2 to: statements size) reject: + [:i| + (statements at: i) == NodeNil + and: [(statements at: i - 1) isNilIf]]. + node statements: (({1}, indices) collect: [:i| statements at: i])]]! Item was added: + ----- Method: MethodNode>>preenTempsConflictingWithBlockNode: (in category 'converting-private') ----- + preenTempsConflictingWithBlockNode: temps + "Push temps that conflict with other blocks down into their narrowest enclosing block scope." + temps do: + [:tempVar| + (self accept: (NarrowerVariableScopeFinder new ofVariable: tempVar)) ifNotNil: + [:enclosingScope | + self assert: enclosingScope isBlockNode. + self nodesDo: + [:node| + ((node == self or: [node isBlockNode]) + and: [node temporaries includes: tempVar]) ifTrue: + [node temporaries: (node temporaries copyWithout: tempVar)]]. + enclosingScope temporaries: enclosingScope temporaries, { tempVar }]]! Item was added: + ----- Method: MethodNode>>preenableNodes (in category 'converting-private') ----- + preenableNodes + "Answer a Dictionary from node or sequence of nodes to preen method selector for nodes + in the tree that require post-processing after either a format or a decompile. Such issues + are the variable for an ifNotNil: which is local to the ifNotNil: block but, due to the inlining + of ifNotNil: appears to be declared at the outer level, and, similarly, a temporary variable + that conflicts with one of the same name in a block when, were the variable declared + local to some inlined block it would no longer conflict. The resulting dictionary is used to + perform the value with the key (node or array) as argument to preen the tree." + + | preenableNodes priorBlocks priorVariables | + preenableNodes := Dictionary new. + priorBlocks := OrderedCollection new. + priorVariables := Set new. + self nodesWithPrecedingStatementsDo: + [:node :precedingStatementOrNil| | variable temps | + (node isMessageNode + and: [node macroPrinter == #printIfNilNotNil:indent: + and: [node receiver isMessageNode + and: [node receiver selector key == #== + and: [node receiver receiver isAssignmentNode + and: [(variable := node receiver receiver variable) isTemp + and: [variable isRemote not + and: [variable isOnlySubnodeOf: node in: self]]]]]]]) ifTrue: + [preenableNodes at: node put: #preenIfNotNilNode:. + priorVariables add: variable]. + node isBlockNode ifTrue: + [temps := OrderedCollection new. + node temporaries do: + [:temp| + priorBlocks do: + [:aBlock| + aBlock temporaries do: + [:priorTemp| + (priorVariables includes: priorTemp) ifFalse: + [priorTemp key = temp key ifTrue: + [temps addLast: priorTemp]]]]]. + temps isEmpty ifFalse: + [preenableNodes at: temps put: #preenTempsConflictingWithBlockNode:]. + priorBlocks addLast: node]. + (node == NodeNil + and: [precedingStatementOrNil notNil + and: [precedingStatementOrNil isMessageNode + and: [precedingStatementOrNil isNilIf]]]) ifTrue: + [preenableNodes at: precedingStatementOrNil put: #preenNilNodeFollowingNilIfNode:]]. + ^preenableNodes! Item was added: + ----- Method: MethodNode>>primitive (in category 'accessing') ----- + primitive + ^primitive! Item was added: + ----- Method: MethodNode>>primitiveErrorVariableName (in category 'accessing') ----- + primitiveErrorVariableName + "Answer the primitive error code temp name, or nil if none." + (primitive isInteger and: [primitive > 0]) ifTrue: + [properties pragmas do: + [:pragma| | kwds ecIndex | + ((kwds := pragma keyword keywords) first = 'primitive:' + and: [(ecIndex := kwds indexOf: 'error:') > 0]) ifTrue: + [^pragma argumentAt: ecIndex]]]. + ^nil + + "(Parser new parse: (MethodNode sourceCodeAt: #primitiveErrorVariableName) class: Parser) primitiveErrorVariableName" + + "(Parser new parse: 'foo <primitive: 111 error: ''foo''> self primitiveFailed' class: Object) primitiveErrorVariableName" + + "(Parser new parse: 'foo <primitive: 111 error: foo> self primitiveFailed' class: Object) primitiveErrorVariableName" + + "(Parser new parse: 'foo <primitive: 111> self primitiveFailed' class: Object) primitiveErrorVariableName" + + "(Parser new parse: 'foo <primitive: ''foo'' error: foo module: ''bar''> self primitiveFailed' class: Object) primitiveErrorVariableName" + + "(Parser new parse: 'foo <primitive: ''foo'' module: ''bar'' error: foo> self primitiveFailed' class: Object) primitiveErrorVariableName" + + "(Parser new parse: 'foo <primitive: 111 error: foo> self primitiveFailed' class: Object) generate"! Item was added: + ----- Method: MethodNode>>printOn: (in category 'printing') ----- + printOn: aStream + | selectorNode | + selectorNode := self selectorNode. + precedence = 1 + ifTrue: + [selectorNode isForFFICall + ifTrue: [selectorNode + printAsFFICallWithArguments: arguments + on: aStream + indent: 0] + ifFalse: [aStream nextPutAll: selectorNode key]] + ifFalse: + [selectorNode key keywords with: arguments do: + [:kwd :arg | + aStream nextPutAll: kwd; space; nextPutAll: arg key; space]]. + comment == nil ifFalse: + [aStream crtab: 1. + self printCommentOn: aStream indent: 1]. + block printTemporaries: temporaries on: aStream doPrior: [aStream crtab: 1]. + primitive > 0 ifTrue: + [(primitive between: 255 and: 519) ifFalse: "Dont decompile quick prims e.g, ^ self or ^instVar" + [aStream crtab: 1. + self printPrimitiveOn: aStream]]. + self printPropertiesOn: aStream. + self printPragmasOn: aStream. + aStream crtab: 1. + block printStatementsOn: aStream indent: 0! Item was added: + ----- Method: MethodNode>>printPragmasOn: (in category 'printing') ----- + printPragmasOn: aStream + properties ifNil: [^self]. + properties pragmas do: + [:pragma| + "Primitives are printed in printPrimitiveOn:; skip these" + (Parser primitivePragmaSelectors includes: pragma keyword) ifFalse: + [aStream crtab: 1; nextPut: $<; print: pragma message; nextPut: $>]]! Item was added: + ----- Method: MethodNode>>printPrimitiveOn: (in category 'printing') ----- + printPrimitiveOn: aStream + "Print the primitive on aStream" + | primDecl | + primitive = 0 ifTrue: + [^self]. + primitive = 120 ifTrue: "External call spec" + [^aStream print: encoder literals first]. + aStream nextPutAll: '<primitive: '. + primitive = 117 + ifTrue: + [primDecl := encoder literals at: 1. + (primDecl at: 2) asString printOn: aStream. + (primDecl at: 1) ifNotNil: + [:moduleName| + aStream nextPutAll:' module: '. + moduleName asString printOn: aStream]] + ifFalse: + [aStream print: primitive]. + self primitiveErrorVariableName ifNotNil: + [:primitiveErrorVariableName| + aStream nextPutAll: ' error: '; nextPutAll: primitiveErrorVariableName]. + aStream nextPut: $>. + ((Smalltalk classNamed: #StackInterpreter) ifNil: [Smalltalk classNamed: #Interpreter]) ifNotNil: + [:interpreterClass| + aStream nextPutAll: ' "', (interpreterClass primitiveTable at: primitive + 1), '" ']! Item was added: + ----- Method: MethodNode>>printPropertiesOn: (in category 'printing') ----- + printPropertiesOn: aStream + properties ifNil: [^self]. + properties propertyKeysAndValuesDo: + [:prop :val| + aStream crtab; nextPut: $<. + prop = #on:in: + ifTrue: + [prop keywords with: val do: + [:k :v | aStream nextPutAll: k; space; nextPutAll: v; space]] + ifFalse: + [prop = #on + ifTrue: [aStream nextPutAll: prop; nextPutAll:': '; nextPutAll: val] + ifFalse: [aStream nextPutAll: prop; nextPutAll:': '; print: val]]. + aStream nextPut: $>]! Item was added: + ----- Method: MethodNode>>printWithClosureAnalysisOn: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream + self ensureClosureAnalysisDone. + precedence = 1 + ifTrue: + [(self selector includesSubstring: '()/') + ifTrue: [aStream nextPutAll: (self selector copyUpTo: $)). + arguments + do: [:arg| aStream nextPutAll: arg key] + separatedBy: [aStream nextPutAll: ', ']. + aStream nextPut: $)] + ifFalse: [aStream nextPutAll: self selector]] "no node for method selector" + ifFalse: + [self selector keywords with: arguments do: + [:kwd :arg | + aStream nextPutAll: kwd; space. + arg printDefinitionForClosureAnalysisOn: aStream. + aStream space]]. + comment == nil ifFalse: + [aStream crtab: 1. + self printCommentOn: aStream indent: 1]. + temporaries size > 0 ifTrue: + [aStream crtab: 1; nextPut: $|. + temporaries do: [:temp | + aStream space. + temp printDefinitionForClosureAnalysisOn: aStream]. + aStream space; nextPut: $|]. + primitive > 0 ifTrue: + [(primitive between: 255 and: 519) ifFalse: "Dont decompile quick prims e.g, ^ self or ^instVar" + [aStream crtab: 1. + self printPrimitiveOn: aStream]]. + self printPropertiesOn: aStream. + self printPragmasOn: aStream. + aStream crtab: 1. + block printWithClosureAnalysisStatementsOn: aStream indent: 0! Item was added: + ----- Method: MethodNode>>properties (in category 'code generation') ----- + properties + ^properties! Item was added: + ----- Method: MethodNode>>rawSourceRanges (in category 'source mapping') ----- + rawSourceRanges + + ^self rawSourceRangesAndMethodDo: [:rawSourceRanges :method| rawSourceRanges]! Item was added: + ----- Method: MethodNode>>rawSourceRangesAndMethodDo: (in category 'source mapping') ----- + rawSourceRangesAndMethodDo: aBinaryBlock + "Evaluate aBinaryBlock with the rawSourceRanges and method generated from the receiver." + + | methNode method | + methNode := encoder classEncoding newParser + encoderClass: encoder class; + parse: (sourceText "If no source, use decompile string as source to map from" + ifNil: [self decompileString] + ifNotNil: [sourceText]) + class: self methodClass. + method := methNode generate. "set bytecodes to map to" + ^aBinaryBlock + value: methNode encoder rawSourceRanges + value: method! Item was added: + ----- Method: MethodNode>>referencedValuesWithinBlockExtent: (in category 'closure analysis') ----- + referencedValuesWithinBlockExtent: anInterval + ^(localsPool select: + [:temp| + temp isReferencedWithinBlockExtent: anInterval]) collect: + [:temp| + temp isRemote ifTrue: [temp remoteNode] ifFalse: [temp]]! Item was added: + ----- Method: MethodNode>>removeAndRenameLastTempIfErrorCode (in category 'primitive error codes') ----- + removeAndRenameLastTempIfErrorCode + self primitiveErrorVariableName ifNotNil: + [:primitiveErrorVariableName| + temporaries last + name: primitiveErrorVariableName + key: primitiveErrorVariableName + code: temporaries last code. + temporaries removeLast].! Item was added: + ----- Method: MethodNode>>removeProperty: (in category 'accessing') ----- + removeProperty: aSymbol + properties := properties copyWithout: (Association + key: aSymbol + value: (properties propertyValueAt: aSymbol))! Item was added: + ----- Method: MethodNode>>schematicTempNamesString (in category 'debugger support') ----- + schematicTempNamesString + "Answer the temp names for the current method node in a form that captures + temp structure. The temps at each method and block scope level occur + space-separated, with any indirect temps enclosed in parentheses. Each block + level is enclosed in square brackets. e.g. + 'method level temps (indirect temp)[block args and temps (indirect)]' + This representation can be reconstituted into a blockExtentsToTempsMap + by a CompiledMethod that has been copied with the schematicTempNamesString." + encoder hasGeneratedMethod ifFalse: + ["create the encoder's blockExtentsToLocals map, except if the method is quick + in which case it has no temps." + self generate isQuick ifTrue: + [^'']]. + ^encoder schematicTempNamesString! Item was added: + ----- Method: MethodNode>>selector (in category 'code generation') ----- + selector + "Answer the message selector for the method represented by the receiver." + + (selectorOrFalse isSymbol) + ifTrue: [^selectorOrFalse]. + ^selectorOrFalse key. + ! Item was added: + ----- Method: MethodNode>>selector: (in category 'initialize-release') ----- + selector: symbol + + selectorOrFalse := symbol! Item was added: + ----- Method: MethodNode>>selector:arguments:precedence:temporaries:block:encoder:primitive: (in category 'initialize-release') ----- + selector: selOrFalse arguments: args precedence: p temporaries: temps block: blk encoder: anEncoder primitive: prim + + self + selector: selOrFalse + arguments: args + precedence: p + temporaries: temps + block: blk encoder: + anEncoder + primitive: prim + properties: AdditionalMethodState new.! Item was added: + ----- Method: MethodNode>>selector:arguments:precedence:temporaries:block:encoder:primitive:properties: (in category 'initialize-release') ----- + selector: selOrFalse arguments: args precedence: p temporaries: temps block: blk encoder: anEncoder primitive: prim properties: propDict + "Initialize the receiver with respect to the arguments given." + + encoder := anEncoder. + selectorOrFalse := selOrFalse. + precedence := p. + arguments := args. + temporaries := temps. + block := blk. + primitive := prim. + properties := propDict.! Item was added: + ----- Method: MethodNode>>selectorNode (in category 'code generation') ----- + selectorNode + "Answer a SelectorNode for the message selector of the method represented by the receiver." + + ^(selectorOrFalse isKindOf: SelectorNode) + ifTrue: [selectorOrFalse] + ifFalse: [SelectorNode new key: selectorOrFalse]! Item was added: + ----- Method: MethodNode>>sourceText (in category 'printing') ----- + sourceText + + ^ sourceText ifNil: [self printString]! Item was added: + ----- Method: MethodNode>>sourceText: (in category 'initialize-release') ----- + sourceText: stringOrText + + sourceText := stringOrText! Item was added: + ----- Method: MethodNode>>tempNames (in category 'printing') ----- + tempNames + ^ encoder tempNames! Item was added: + ----- Method: MethodNode>>temporaries (in category 'accessing') ----- + temporaries + "For transformations etc, not used in compilation" + ^temporaries! Item was added: + ----- Method: MethodNode>>temporaries: (in category 'accessing') ----- + temporaries: aSequence + "For transformations etc, not used in compilation" + temporaries := aSequence! Item was added: + ParseNode subclass: #MethodTempsNode + instanceVariableNames: 'temporaries' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! Item was added: + VariableScopeFinder subclass: #NarrowerVariableScopeFinder + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !NarrowerVariableScopeFinder commentStamp: 'eem 4/3/2017 11:59' prior: 0! + A NarrowerVariableScopeFinder is used to find a smaller scope for an already declared variable.! Item was added: + ----- Method: NarrowerVariableScopeFinder>>visitTempVariableNode: (in category 'visiting') ----- + visitTempVariableNode: aVariableNode + ^theVariable = aVariableNode ifTrue: [theVariable]! Item was added: + ----- Method: NarrowerVariableScopeFinder>>visitUndeclaredVariableNode: (in category 'visiting') ----- + visitUndeclaredVariableNode: aVariableNode + ^nil! Item was added: + ParseNode subclass: #NewArrayNode + instanceVariableNames: 'numElements' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !NewArrayNode commentStamp: '<historical>' prior: 0! + I represent a node for the genPushNewArray: opcode.! Item was added: + ----- Method: NewArrayNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitNewArrayNode: self! Item was added: + ----- Method: NewArrayNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + "This is a no-op except in TempVariableNode" + ^self! Item was added: + ----- Method: NewArrayNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + encoder genPushNewArray: numElements. + stack push: 1! Item was added: + ----- Method: NewArrayNode>>numElements (in category 'accessing') ----- + numElements + ^numElements! Item was added: + ----- Method: NewArrayNode>>numElements: (in category 'accessing') ----- + numElements: n + numElements := n! Item was added: + ----- Method: NewArrayNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + ^encoder sizePushNewArray: numElements! Item was added: + ParseNodeVisitor subclass: #OptimizedBlockLocalTempReadBeforeWrittenVisitor + instanceVariableNames: 'inOptimizedBlock readBeforeWritten written' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !OptimizedBlockLocalTempReadBeforeWrittenVisitor commentStamp: '<historical>' prior: 0! + Answer the set of temporary variables that are read before they are written in the visited parse tree. Used by the compiler to detect those block-local temporaries of blocks in optimized loops that require nilling to prevent a value from a previous iteration persisting into a subsequent one.! Item was added: + ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>initialize (in category 'initialize-release') ----- + initialize + inOptimizedBlock := false! Item was added: + ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>readBeforeWritten (in category 'accessing') ----- + readBeforeWritten + ^readBeforeWritten ifNil: [IdentitySet new]! Item was added: + ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>visitAssignmentNode: (in category 'visiting') ----- + visitAssignmentNode: anAssignmentNode + anAssignmentNode value accept: self. + anAssignmentNode variable isTemp + ifTrue: + [written ifNil: [written := IdentitySet new]. + written add: anAssignmentNode variable] + ifFalse: + [anAssignmentNode variable accept: self]! Item was added: + ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>visitBlockNode: (in category 'visiting') ----- + visitBlockNode: aBlockNode + | savedWritten | + "If we're in the optimized block in one side of an optimized ifTrue:ifFalse: et al + leave it to the enclosing visitMessageNode: activation to handle merging written." + inOptimizedBlock ifTrue: + [^super visitBlockNode: aBlockNode]. + "If we're not then don't update written because without evaluating the guard(s) + we can't tell if the block is evaluated or not, and we must avoid false positives." + savedWritten := written copy. + super visitBlockNode: aBlockNode. + written := savedWritten! Item was added: + ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>visitMessageNode: (in category 'visiting') ----- + visitMessageNode: aMessageNode + | savedWritten writtenPostFirstArm | + (aMessageNode isOptimized + and: [#(ifTrue:ifFalse: ifFalse:ifTrue: ifNil:ifNotNil: ifNotNil:ifNil:) includes: aMessageNode selector key]) ifFalse: + [^super visitMessageNode: aMessageNode]. + aMessageNode receiver accept: self. + aMessageNode selector accept: self. + savedWritten := written copy. + aMessageNode argumentsInEvaluationOrder + do: [:argument| + argument isBlockNode + ifTrue: [| savedIOB | + savedIOB := inOptimizedBlock. + inOptimizedBlock := true. + [argument accept: self] + ensure: [inOptimizedBlock := savedIOB]] + ifFalse: [argument accept: self]] + separatedBy: + [writtenPostFirstArm := written. + written := savedWritten]. + (written notNil + and: [writtenPostFirstArm notNil]) ifTrue: + [written := written intersection: writtenPostFirstArm]! Item was added: + ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>visitTempVariableNode: (in category 'visiting') ----- + visitTempVariableNode: aTempVariableNode + (aTempVariableNode isArg + or: [written notNil + and: [written includes: aTempVariableNode]]) ifTrue: + [^self]. + readBeforeWritten ifNil: + [readBeforeWritten := IdentitySet new]. + readBeforeWritten add: aTempVariableNode! Item was added: + Notification subclass: #OutOfScopeNotification + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Exceptions'! Item was added: + ----- Method: OutOfScopeNotification>>defaultAction (in category 'priv handling') ----- + defaultAction + + ^false! Item was added: + Object subclass: #ParseNode + instanceVariableNames: 'comment pc' + classVariableNames: 'CodeBases CodeLimits LdFalse LdInstType LdLitIndType LdLitType LdMinus1 LdNil LdSelf LdSuper LdTempType LdThisContext LdTrue LoadLong NodeFalse NodeNil NodeSelf NodeSuper NodeThisContext NodeTrue Send SendPlus SendType StdLiterals StdSelectors StdVariables' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !ParseNode commentStamp: '<historical>' prior: 0! + This superclass of most compiler/decompiler classes declares common class variables, default messages, and the code emitters for jumps. Some of the class variables are initialized here; the rest are initialized in class VariableNode.! Item was added: + ----- Method: ParseNode class>>initialize (in category 'class initialization') ----- + initialize + "ParseNode initialize. VariableNode initialize" + LdInstType := 1. + LdTempType := 2. + LdLitType := 3. + LdLitIndType := 4. + SendType := 5. + "Back in the day the following constants corresponded to bytecodes. + Now they're just unique values that need to be eliminated when and if + things like code:type: are cleaned up." + CodeBases := #(0 16 32 64 208 ). + CodeLimits := #(16 16 32 32 16 ). + LdSelf := 112. + LdTrue := 113. + LdFalse := 114. + LdNil := 115. + LdMinus1 := 116. + LoadLong := 128. + LdSuper := 133. + LdThisContext := 137. + SendPlus := 176. + Send := 208 + + "((ParseNode class >> #initialize) literals select: [:l| l isVariableBinding and: [(ParseNode classPool includesAssociation: l) and: [(self systemNavigation allCallsOn: l localTo: ParseNode) size = 1]]]) sort: [:a :b| a key <= b key]" + + "ParseNode classPool associations select: [:a| (self systemNavigation allCallsOn: a localTo: ParseNode) isEmpty]"! Item was added: + ----- Method: ParseNode class>>pushNilCode (in category 'accessing') ----- + pushNilCode + + ^LdNil! Item was added: + ----- Method: ParseNode class>>tempSortBlock (in category 'accessing') ----- + tempSortBlock + "Answer a block that can sort a set of temporaries into a stable + order so that different compilations produce the same results." + ^[:t1 :t2| | be1 be2 bs1 bs2 | + t1 index < t2 index "simple sort by index." + or: [t1 index = t2 index "complex tie break" + and: [t1 isRemote ~= t2 isRemote + ifTrue: [t2 isRemote] "put direct temps before indirect temps" + ifFalse: + [((be1 := t1 definingScope blockExtent) isNil + or: [(be2 := t2 definingScope blockExtent) isNil]) + ifTrue: [t1 name < t2 name] "only have the name left to go on" + ifFalse: "put temps from outer scopes before those from inner scopes" + [(bs1 := be1 first) < (bs2 := be2 first) + or: [bs1 = bs2 and: [t1 name < t2 name]]]]]]] "only have the name left to go on"! Item was added: + ----- Method: ParseNode>>accept: (in category 'visiting') ----- + accept: aVisitor + "Accept a visitor by double-dispatching to a type-specific method on the visitor, e.g. visitBlockNode:. + All such implementations under ParseNode should answer the result of the dispatch, e.g. + ^aVisitor visitBlockNode: self" + ^self subclassResponsibility! Item was added: + ----- Method: ParseNode>>asReturnNode (in category 'converting') ----- + asReturnNode + + ^ReturnNode new expr: self! Item was added: + ----- Method: ParseNode>>assignmentCheck:at: (in category 'testing') ----- + assignmentCheck: encoder at: location + "For messageNodes masquerading as variables for the debugger. + For now we let this through - ie we allow stores ev + into args. Should check against numArgs, though." + ^ -1! Item was added: + ----- Method: ParseNode>>canCascade (in category 'testing') ----- + canCascade + + ^false! Item was added: + ----- Method: ParseNode>>comment (in category 'comment') ----- + comment + + ^comment! Item was added: + ----- Method: ParseNode>>comment: (in category 'comment') ----- + comment: newComment + + comment := newComment! Item was added: + ----- Method: ParseNode>>emitCodeForBlockValue:encoder: (in category 'code generation') ----- + emitCodeForBlockValue: stack encoder: encoder + "Generate code for evaluating the last statement in a block" + ^self emitCodeForValue: stack encoder: encoder! Item was added: + ----- Method: ParseNode>>emitCodeForBranchOn:dist:pop:encoder: (in category 'code generation') ----- + emitCodeForBranchOn: condition dist: dist pop: stack encoder: encoder + stack pop: 1. + dist = 0 ifTrue: [^encoder genPop]. + condition + ifTrue: [encoder genBranchPopTrue: dist] + ifFalse: [encoder genBranchPopFalse: dist]! Item was added: + ----- Method: ParseNode>>emitCodeForEffect:encoder: (in category 'code generation') ----- + emitCodeForEffect: stack encoder: encoder + + self emitCodeForValue: stack encoder: encoder. + encoder genPop. + stack pop: 1! Item was added: + ----- Method: ParseNode>>emitCodeForJump:encoder: (in category 'code generation') ----- + emitCodeForJump: dist encoder: encoder + + dist = 0 ifFalse: [encoder genJump: dist]! Item was added: + ----- Method: ParseNode>>emitCodeForReturn:encoder: (in category 'code generation') ----- + emitCodeForReturn: stack encoder: encoder + + self emitCodeForValue: stack encoder: encoder. + encoder genReturnTop! Item was added: + ----- Method: ParseNode>>encodeSelector: (in category 'encoding') ----- + encodeSelector: selector + + ^nil! Item was added: + ----- Method: ParseNode>>ensureCanCascade: (in category 'testing') ----- + ensureCanCascade: encoder! Item was added: + ----- Method: ParseNode>>ifNilReceiver (in category 'private') ----- + ifNilReceiver + "assuming this object is the receiver of an ifNil:, what object is being asked about?" + ^self! Item was added: + ----- Method: ParseNode>>ifNilTemporary (in category 'private') ----- + ifNilTemporary + + ^ nil! Item was added: + ----- Method: ParseNode>>ifNilValue (in category 'private') ----- + ifNilValue + + ^self! Item was added: + ----- Method: ParseNode>>isArg (in category 'testing') ----- + isArg + + ^false! Item was added: + ----- Method: ParseNode>>isAssignmentNode (in category 'testing') ----- + isAssignmentNode + ^false! Item was added: + ----- Method: ParseNode>>isBlockNode (in category 'testing') ----- + isBlockNode + ^false! Item was added: + ----- Method: ParseNode>>isBraceNode (in category 'testing') ----- + isBraceNode + ^false! Item was added: + ----- Method: ParseNode>>isComplex (in category 'testing') ----- + isComplex + "Used for pretty printing to determine whether to start a new line" + + ^false! Item was added: + ----- Method: ParseNode>>isConstantNumber (in category 'testing') ----- + isConstantNumber "Overridden in LiteralNode" + ^false! Item was added: + ----- Method: ParseNode>>isDoIt (in category 'testing') ----- + isDoIt + "polymorphic with RBNodes; called by debugger" + + ^ false! Item was added: + ----- Method: ParseNode>>isFutureNode (in category 'testing') ----- + isFutureNode + ^false! Item was added: + ----- Method: ParseNode>>isJust: (in category 'testing') ----- + isJust: node + ^false! Item was added: + ----- Method: ParseNode>>isLiteralNode (in category 'testing') ----- + isLiteralNode + + ^ false! Item was added: + ----- Method: ParseNode>>isMessage (in category 'testing') ----- + isMessage + ^false! Item was added: + ----- Method: ParseNode>>isMessage:receiver:arguments: (in category 'testing') ----- + isMessage: selSymbol receiver: rcvrPred arguments: argsPred + "See comment in MessageNode." + + ^false! Item was added: + ----- Method: ParseNode>>isMessageNode (in category 'testing') ----- + isMessageNode + ^false! Item was added: + ----- Method: ParseNode>>isOnlySubnodeOf:in: (in category 'testing') ----- + isOnlySubnodeOf: aSubtree "<ParseNode>" in: aParseTree "<ParseNode>" + "Answer if the receiver only occurs within aSubtree of aParseTree, not in the rest of aParseTree. + Assumes that aSubtree is in fact a subnode of aParseTree." + | isSubnode | + isSubnode := false. + aSubtree accept: (ParseNodeEnumerator + ofBlock: [:node| node == self ifTrue: [isSubnode := true]]). + isSubnode ifFalse: + [^false]. + aParseTree accept: (ParseNodeEnumerator + ofBlock: [:node| node == self ifTrue: [^false]] + select: [:node| node ~= aSubtree]). + ^true! Item was added: + ----- Method: ParseNode>>isReturnSelf (in category 'testing') ----- + isReturnSelf + + ^false! Item was added: + ----- Method: ParseNode>>isReturningIf (in category 'testing') ----- + isReturningIf + + ^false! Item was added: + ----- Method: ParseNode>>isSelfPseudoVariable (in category 'testing') ----- + isSelfPseudoVariable + "Overridden in VariableNode." + ^false! Item was added: + ----- Method: ParseNode>>isSpecialConstant (in category 'testing') ----- + isSpecialConstant + ^ false! Item was added: + ----- Method: ParseNode>>isTemp (in category 'testing') ----- + isTemp + ^ false! Item was added: + ----- Method: ParseNode>>isUndefTemp (in category 'testing') ----- + isUndefTemp + ^ false! Item was added: + ----- Method: ParseNode>>isUnusedTemp (in category 'testing') ----- + isUnusedTemp + ^ false! Item was added: + ----- Method: ParseNode>>isVariableNode (in category 'testing') ----- + isVariableNode + ^false! Item was added: + ----- Method: ParseNode>>isVariableReference (in category 'testing') ----- + isVariableReference + + ^false! Item was added: + ----- Method: ParseNode>>nextWordFrom:setCharacter: (in category 'private') ----- + nextWordFrom: aStream setCharacter: aBlock + | outStream char | + outStream := WriteStream on: (String new: 16). + [(aStream peekFor: Character space) + or: [aStream peekFor: Character tab]] whileTrue. + [aStream atEnd + or: + [char := aStream next. + char = Character cr or: [char = Character space]]] + whileFalse: [outStream nextPut: char]. + aBlock value: char. + ^ outStream contents! Item was added: + ----- Method: ParseNode>>nodePrintOn:indent: (in category 'printing') ----- + nodePrintOn: aStrm indent: nn + | var aaStrm myLine | + "Show just the sub nodes and the code." + + (aaStrm := aStrm) ifNil: [aaStrm := WriteStream on: (String new: 500)]. + nn timesRepeat: [aaStrm tab]. + aaStrm nextPutAll: self class name; space. + myLine := self printString copyWithout: Character cr. + myLine := myLine copyFrom: 1 to: (myLine size min: 70). + aaStrm nextPutAll: myLine; cr. + 1 to: self class instSize do: [:ii | + var := self instVarAt: ii. + (var respondsTo: #asReturnNode) ifTrue: [var nodePrintOn: aaStrm indent: nn+1]]. + 1 to: self class instSize do: [:ii | + var := self instVarAt: ii. + (var isKindOf: SequenceableCollection) ifTrue: [ + var do: [:aNode | + (aNode respondsTo: #asReturnNode) ifTrue: [ + aNode nodePrintOn: aaStrm indent: nn+1]]]]. + ^ aaStrm + ! Item was added: + ----- Method: ParseNode>>nodesDo: (in category 'visiting') ----- + nodesDo: aBlock + self accept: (ParseNodeEnumerator ofBlock: aBlock)! Item was added: + ----- Method: ParseNode>>nodesWithPrecedingStatementsDo: (in category 'visiting') ----- + nodesWithPrecedingStatementsDo: aBinaryBlock + self accept: (ParseNodeWithPrecedingStatementEnumerator ofBlock: aBinaryBlock)! Item was added: + ----- Method: ParseNode>>nowHasDef (in category 'testing') ----- + nowHasDef "Ignored in all but VariableNode"! Item was added: + ----- Method: ParseNode>>nowHasRef (in category 'testing') ----- + nowHasRef "Ignored in all but VariableNode"! Item was added: + ----- Method: ParseNode>>pc (in category 'code generation') ----- + pc + "Used by encoder source mapping." + + ^pc ifNil: [ 0 ] + ! Item was added: + ----- Method: ParseNode>>pc: (in category 'code generation') ----- + pc: anInteger + "Used by encoder source mapping." + + pc := anInteger! Item was added: + ----- Method: ParseNode>>printCommentOn:indent: (in category 'printing') ----- + printCommentOn: aStream indent: indent + | thisComment | + self comment == nil ifTrue: [^ self]. + 1 to: self comment size + do: [:index | + index > 1 ifTrue: [aStream crtab: indent]. + aStream nextPut: $". + thisComment := self comment at: index. + self printSingleComment: thisComment + on: aStream + indent: indent. + aStream nextPut: $"]! Item was added: + ----- Method: ParseNode>>printOn: (in category 'printing') ----- + printOn: aStream + "Refer to the comment in Object|printOn:." + + aStream nextPut: ${. + self printOn: aStream indent: 0. + aStream nextPut: $}.! Item was added: + ----- Method: ParseNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: anInteger + "If control gets here, avoid recursion loop." + + super printOn: aStream! Item was added: + ----- Method: ParseNode>>printOn:indent:precedence: (in category 'printing') ----- + printOn: aStream indent: level precedence: p + + self printOn: aStream indent: level! Item was added: + ----- Method: ParseNode>>printSingleComment:on:indent: (in category 'private') ----- + printSingleComment: aString on: aStream indent: indent + "Print the comment string, assuming it has been indented indent tabs. + Break the string at word breaks, given the widths in the default + font, at 450 points." + + | readStream word position lineBreak font wordWidth tabWidth spaceWidth lastChar | + readStream := ReadStream on: aString. + font := TextStyle default defaultFont. + tabWidth := TextStyle default tabWidth. + spaceWidth := font widthOf: Character space. + position := indent * tabWidth. + lineBreak := 450. + [readStream atEnd] + whileFalse: + [word := self nextWordFrom: readStream setCharacter: [:lc | lastChar := lc]. + wordWidth := word inject: 0 into: [:width :char | width + (font widthOf: char)]. + position := position + wordWidth. + position > lineBreak + ifTrue: + [aStream skip: -1; crtab: indent. + position := indent * tabWidth + wordWidth + spaceWidth. + lastChar = Character cr + ifTrue: [[readStream peekFor: Character tab] whileTrue]. + word isEmpty ifFalse: [aStream nextPutAll: word; space]] + ifFalse: + [aStream nextPutAll: word. + readStream atEnd + ifFalse: + [position := position + spaceWidth. + aStream space]. + lastChar = Character cr + ifTrue: + [aStream skip: -1; crtab: indent. + position := indent * tabWidth. + [readStream peekFor: Character tab] whileTrue]]]! Item was added: + ----- Method: ParseNode>>printWithClosureAnalysis (in category 'printing') ----- + printWithClosureAnalysis + + ^String streamContents: [:str| self printWithClosureAnalysisOn: str]! Item was added: + ----- Method: ParseNode>>printWithClosureAnalysisOn: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream + "Refer to the comment in Object|printOn:." + + aStream nextPut: ${. + self printWithClosureAnalysisOn: aStream indent: 0. + aStream nextPut: $}.! Item was added: + ----- Method: ParseNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: anInteger + "If control gets here, avoid recursion loop." + + super printWithClosureAnalysisOn: aStream! Item was added: + ----- Method: ParseNode>>printWithClosureAnalysisOn:indent:precedence: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level precedence: p + + self printWithClosureAnalysisOn: aStream indent: level! Item was added: + ----- Method: ParseNode>>shortPrintOn: (in category 'printing') ----- + shortPrintOn: aStream + self printOn: aStream indent: 0! Item was added: + ----- Method: ParseNode>>sizeCode:forBranchOn:dist: (in category 'code generation') ----- + sizeCode: encoder forBranchOn: condition dist: dist + dist = 0 ifTrue: [^encoder sizePop]. + ^condition + ifTrue: [encoder sizeBranchPopTrue: dist] + ifFalse: [encoder sizeBranchPopFalse: dist]! Item was added: + ----- Method: ParseNode>>sizeCode:forJump: (in category 'code generation') ----- + sizeCode: encoder forJump: dist + + ^dist = 0 ifTrue: [0] ifFalse: [encoder sizeJump: dist]! Item was added: + ----- Method: ParseNode>>sizeCodeForBlockValue: (in category 'code generation') ----- + sizeCodeForBlockValue: encoder + "Answer the size for evaluating the last statement in a block" + ^self sizeCodeForValue: encoder! Item was added: + ----- Method: ParseNode>>sizeCodeForEffect: (in category 'code generation') ----- + sizeCodeForEffect: encoder + + ^(self sizeCodeForValue: encoder) + encoder sizePop! Item was added: + ----- Method: ParseNode>>sizeCodeForReturn: (in category 'code generation') ----- + sizeCodeForReturn: encoder + + ^(self sizeCodeForValue: encoder) + encoder sizeReturnTop! Item was added: + ----- Method: ParseNode>>toDoIncrement: (in category 'testing') ----- + toDoIncrement: ignored + "Only meant for Messages or Assignments - else return nil" + ^ nil! Item was added: + ParseNodeVisitor subclass: #ParseNodeEnumerator + instanceVariableNames: 'theBlock theSelectBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !ParseNodeEnumerator commentStamp: 'eem 3/19/2019 11:58' prior: 0! + ParseNodeEnumerator implements ParseNode>>nodesDo:. It can be used to enumerate an entire tree via + aParseNode accept: (ParseNodeEnumerator ofBlock: aBlock) + or selectively, excluding the node and subnodes for which selectBlock answers false, via + aParseNode accept: (ParseNodeEnumerator + ofBlock: aBlock + select: selectBlock) + Instance Variables + theBlock: <BlockClosure> + theSelectBlock: <BlockClosure | nil> + + theBlock + - the block that is evaluated with the parse nodes the receiver visits. + + theSelectBlock + - an optional block used to select blocks to visit and descend into. + + Here's a doIt that generates and compiles the visiting methods: + + self superclass selectors do: + [:s| + self compile: (String streamContents: + [:str| | arg | + arg := 'a', (s allButFirst: 5) allButLast. + str nextPutAll: s, ' ', arg; crtab; + nextPutAll: '(theSelectBlock isNil or: [theSelectBlock value: '; nextPutAll: arg; nextPutAll: ']) ifFalse:'; crtab; + tab: 2; nextPutAll: '[^nil].'; crtab; + nextPutAll: 'theBlock value: '; nextPutAll: arg; nextPut: $.; crtab; + nextPutAll: '^super '; nextPutAll: s, ' ', arg])]! Item was added: + ----- Method: ParseNodeEnumerator class>>ofBlock: (in category 'instance creation') ----- + ofBlock: aBlock + ^self new ofBlock: aBlock! Item was added: + ----- Method: ParseNodeEnumerator class>>ofBlock:select: (in category 'instance creation') ----- + ofBlock: aBlock select: selectBlock + ^self new ofBlock: aBlock select: selectBlock! Item was added: + ----- Method: ParseNodeEnumerator>>ofBlock: (in category 'initialize-release') ----- + ofBlock: aBlock + theBlock := aBlock! Item was added: + ----- Method: ParseNodeEnumerator>>ofBlock:select: (in category 'initialize-release') ----- + ofBlock: aBlock select: aSelectBlock + theBlock := aBlock. + theSelectBlock := aSelectBlock! Item was added: + ----- Method: ParseNodeEnumerator>>visitAssignmentNode: (in category 'visiting') ----- + visitAssignmentNode: anAssignmentNode + (theSelectBlock isNil or: [theSelectBlock value: anAssignmentNode]) ifFalse: + [^nil]. + theBlock value: anAssignmentNode. + ^super visitAssignmentNode: anAssignmentNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitBlockNode: (in category 'visiting') ----- + visitBlockNode: aBlockNode + (theSelectBlock isNil or: [theSelectBlock value: aBlockNode]) ifFalse: + [^nil]. + theBlock value: aBlockNode. + ^super visitBlockNode: aBlockNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitBraceNode: (in category 'visiting') ----- + visitBraceNode: aBraceNode + (theSelectBlock isNil or: [theSelectBlock value: aBraceNode]) ifFalse: + [^nil]. + theBlock value: aBraceNode. + ^super visitBraceNode: aBraceNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitCascadeNode: (in category 'visiting') ----- + visitCascadeNode: aCascadeNode + (theSelectBlock isNil or: [theSelectBlock value: aCascadeNode]) ifFalse: + [^nil]. + theBlock value: aCascadeNode. + ^super visitCascadeNode: aCascadeNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitCommentNode: (in category 'visiting') ----- + visitCommentNode: aCommentNode + (theSelectBlock isNil or: [theSelectBlock value: aCommentNode]) ifFalse: + [^nil]. + theBlock value: aCommentNode. + ^super visitCommentNode: aCommentNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitFieldNode: (in category 'visiting') ----- + visitFieldNode: aFieldNode + (theSelectBlock isNil or: [theSelectBlock value: aFieldNode]) ifFalse: + [^nil]. + theBlock value: aFieldNode. + ^super visitFieldNode: aFieldNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitFutureNode: (in category 'visiting') ----- + visitFutureNode: aFutureNode + (theSelectBlock isNil or: [theSelectBlock value: aFutureNode]) ifFalse: + [^nil]. + theBlock value: aFutureNode. + ^super visitFutureNode: aFutureNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitInstanceVariableNode: (in category 'visiting') ----- + visitInstanceVariableNode: anInstanceVariableNode + (theSelectBlock isNil or: [theSelectBlock value: anInstanceVariableNode]) ifFalse: + [^nil]. + theBlock value: anInstanceVariableNode. + ^super visitInstanceVariableNode: anInstanceVariableNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitLiteralNode: (in category 'visiting') ----- + visitLiteralNode: aLiteralNode + (theSelectBlock isNil or: [theSelectBlock value: aLiteralNode]) ifFalse: + [^nil]. + theBlock value: aLiteralNode. + ^super visitLiteralNode: aLiteralNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitLiteralVariableNode: (in category 'visiting') ----- + visitLiteralVariableNode: aLiteralVariableNode + (theSelectBlock isNil or: [theSelectBlock value: aLiteralVariableNode]) ifFalse: + [^nil]. + theBlock value: aLiteralVariableNode. + ^super visitLiteralVariableNode: aLiteralVariableNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitMessageNode: (in category 'visiting') ----- + visitMessageNode: aMessageNode + (theSelectBlock isNil or: [theSelectBlock value: aMessageNode]) ifFalse: + [^nil]. + theBlock value: aMessageNode. + ^super visitMessageNode: aMessageNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitMessageNodeInCascade: (in category 'visiting') ----- + visitMessageNodeInCascade: aMessageNodeInCascade + (theSelectBlock isNil or: [theSelectBlock value: aMessageNodeInCascade]) ifFalse: + [^nil]. + theBlock value: aMessageNodeInCascade. + ^super visitMessageNodeInCascade: aMessageNodeInCascade! Item was added: + ----- Method: ParseNodeEnumerator>>visitMethodNode: (in category 'visiting') ----- + visitMethodNode: aMethodNode + (theSelectBlock isNil or: [theSelectBlock value: aMethodNode]) ifFalse: + [^nil]. + theBlock value: aMethodNode. + ^super visitMethodNode: aMethodNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitNewArrayNode: (in category 'visiting') ----- + visitNewArrayNode: aNewArrayNode + (theSelectBlock isNil or: [theSelectBlock value: aNewArrayNode]) ifFalse: + [^nil]. + theBlock value: aNewArrayNode. + ^super visitNewArrayNode: aNewArrayNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitRemoteTempVectorNode: (in category 'visiting') ----- + visitRemoteTempVectorNode: aRemoteTempVectorNode + (theSelectBlock isNil or: [theSelectBlock value: aRemoteTempVectorNode]) ifFalse: + [^nil]. + theBlock value: aRemoteTempVectorNode. + ^super visitRemoteTempVectorNode: aRemoteTempVectorNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitReturnNode: (in category 'visiting') ----- + visitReturnNode: aReturnNode + (theSelectBlock isNil or: [theSelectBlock value: aReturnNode]) ifFalse: + [^nil]. + theBlock value: aReturnNode. + ^super visitReturnNode: aReturnNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitSelectorNode: (in category 'visiting') ----- + visitSelectorNode: aSelectorNode + (theSelectBlock isNil or: [theSelectBlock value: aSelectorNode]) ifFalse: + [^nil]. + theBlock value: aSelectorNode. + ^super visitSelectorNode: aSelectorNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitTempVariableNode: (in category 'visiting') ----- + visitTempVariableNode: aTempVariableNode + (theSelectBlock isNil or: [theSelectBlock value: aTempVariableNode]) ifFalse: + [^nil]. + theBlock value: aTempVariableNode. + ^super visitTempVariableNode: aTempVariableNode! Item was added: + ----- Method: ParseNodeEnumerator>>visitVariableNode: (in category 'visiting') ----- + visitVariableNode: aVariableNode + (theSelectBlock isNil or: [theSelectBlock value: aVariableNode]) ifFalse: + [^nil]. + theBlock value: aVariableNode. + ^super visitVariableNode: aVariableNode! Item was added: + Object subclass: #ParseNodeVisitor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !ParseNodeVisitor commentStamp: '<historical>' prior: 0! + I am an abstract superclass for ParseNode visitors that functions as a null visitor. Here's the code that defines my interface: + + (SystemNavigation default allImplementorsOf: #accept: localTo: ParseNode) do: + [:methodReference| + methodReference compiledMethod messages do: + [:sel| + ((sel beginsWith: 'visit') + and: [sel numArgs = 1]) ifTrue: + [ParseNodeVisitor + compile: (String streamContents: + [:str| + str nextPutAll: sel; + space; + nextPut: $a. + methodReference classSymbol first isVowel ifTrue: + [str nextPut: $n]. + str nextPutAll: methodReference classSymbol]) + classified: 'visiting']]]! Item was added: + ----- Method: ParseNodeVisitor>>visitAssignmentNode: (in category 'visiting') ----- + visitAssignmentNode: anAssignmentNode + "N.B. since assigment happens after the value is evaluated the value is visited first." + anAssignmentNode value accept: self. + anAssignmentNode variable accept: self! Item was added: + ----- Method: ParseNodeVisitor>>visitBlockNode: (in category 'visiting') ----- + visitBlockNode: aBlockNode + aBlockNode statements do: + [:statement| statement accept: self]! Item was added: + ----- Method: ParseNodeVisitor>>visitBraceNode: (in category 'visiting') ----- + visitBraceNode: aBraceNode + aBraceNode elements do: + [:element| element accept: self]! Item was added: + ----- Method: ParseNodeVisitor>>visitCascadeNode: (in category 'visiting') ----- + visitCascadeNode: aCascadeNode + aCascadeNode receiver accept: self. + aCascadeNode messages do: + [:message| self visitMessageNodeInCascade: message]! Item was added: + ----- Method: ParseNodeVisitor>>visitCommentNode: (in category 'visiting') ----- + visitCommentNode: aCommentNode! Item was added: + ----- Method: ParseNodeVisitor>>visitFieldNode: (in category 'visiting') ----- + visitFieldNode: aFieldNode! Item was added: + ----- Method: ParseNodeVisitor>>visitFutureNode: (in category 'visiting') ----- + visitFutureNode: aFutureNode + aFutureNode receiver accept: self. + (aFutureNode originalSelector isKindOf: SelectorNode) ifTrue: + [aFutureNode originalSelector accept: self]! Item was added: + ----- Method: ParseNodeVisitor>>visitInstanceVariableNode: (in category 'visiting') ----- + visitInstanceVariableNode: anInstanceVariableNode! Item was added: + ----- Method: ParseNodeVisitor>>visitLiteralNode: (in category 'visiting') ----- + visitLiteralNode: aLiteralNode! Item was added: + ----- Method: ParseNodeVisitor>>visitLiteralVariableNode: (in category 'visiting') ----- + visitLiteralVariableNode: aLiteralVariableNode! Item was added: + ----- Method: ParseNodeVisitor>>visitMessageNode: (in category 'visiting') ----- + visitMessageNode: aMessageNode + aMessageNode receiver accept: self. + "receiver notNil ifTrue: ''receiver is nil for cascades'' + [receiver accept: self]." + aMessageNode selector accept: self. + aMessageNode argumentsInEvaluationOrder do: + [:argument| argument accept: self]! Item was added: + ----- Method: ParseNodeVisitor>>visitMessageNodeInCascade: (in category 'visiting') ----- + visitMessageNodeInCascade: aMessageNode + "receiver is nil for cascades" + aMessageNode selector accept: self. + aMessageNode argumentsInEvaluationOrder do: + [:argument| argument accept: self]! Item was added: + ----- Method: ParseNodeVisitor>>visitMethodNode: (in category 'visiting') ----- + visitMethodNode: aMethodNode + aMethodNode block accept: self! Item was added: + ----- Method: ParseNodeVisitor>>visitNewArrayNode: (in category 'visiting') ----- + visitNewArrayNode: aNewArrayNode! Item was added: + ----- Method: ParseNodeVisitor>>visitRemoteTempVectorNode: (in category 'visiting') ----- + visitRemoteTempVectorNode: aRemoteTempVectorNode! Item was added: + ----- Method: ParseNodeVisitor>>visitReturnNode: (in category 'visiting') ----- + visitReturnNode: aReturnNode + aReturnNode expr accept: self! Item was added: + ----- Method: ParseNodeVisitor>>visitSelectorNode: (in category 'visiting') ----- + visitSelectorNode: aSelectorNode! Item was added: + ----- Method: ParseNodeVisitor>>visitTempVariableNode: (in category 'visiting') ----- + visitTempVariableNode: aTempVariableNode! Item was added: + ----- Method: ParseNodeVisitor>>visitUndeclaredVariableNode: (in category 'visiting') ----- + visitUndeclaredVariableNode: aVariableNode! Item was added: + ----- Method: ParseNodeVisitor>>visitVariableNode: (in category 'visiting') ----- + visitVariableNode: aVariableNode! Item was added: + ParseNodeEnumerator subclass: #ParseNodeWithPrecedingStatementEnumerator + instanceVariableNames: 'precedingStatement' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !ParseNodeWithPrecedingStatementEnumerator commentStamp: 'eem 3/19/2019 11:55' prior: 0! + A ParseNodeWithPrecedingStatementEnumerator is a ParseNodeEnumerator that accepts a binary block in ofBlock:, and hence enumerates statement nodes with their preceding statement, or nil if they are the first. + + Instance Variables + precedingStatement: <ParseNode | nil> + + precedingStatement + - the preceding statement node, if any + ! Item was added: + ----- Method: ParseNodeWithPrecedingStatementEnumerator>>ofBlock: (in category 'initialize-release') ----- + ofBlock: aBlock + "N.B. This enumerator visits a node before any of the node's children. + Hence, when enumerating statements in a block, we can ensure that + the second argument to the block, the preceding statement, is non-nil + only for top-level statements in the block by nilling out precedingStatement + once the block is evaluated. Perhaps stronger would be to capture its value + in a temporary and nil it before evaluating, but this is good enough." + theBlock := [:node| + aBlock value: node value: precedingStatement. + precedingStatement := nil]! Item was added: + ----- Method: ParseNodeWithPrecedingStatementEnumerator>>ofBlock:select: (in category 'initialize-release') ----- + ofBlock: aBlock select: aSelectBlock + self ofBlock: aBlock. + theSelectBlock := aSelectBlock! Item was added: + ----- Method: ParseNodeWithPrecedingStatementEnumerator>>visitBlockNode: (in category 'visiting') ----- + visitBlockNode: aBlockNode + | savedPrecedingStatement | + (theSelectBlock isNil or: [theSelectBlock value: aBlockNode]) ifFalse: + [^nil]. + theBlock value: aBlockNode. + savedPrecedingStatement := precedingStatement. + precedingStatement := nil. + [aBlockNode statements do: + [:statement| + statement accept: self. + precedingStatement := statement]] ensure: + [precedingStatement := savedPrecedingStatement]! Item was added: + Object subclass: #ParseStack + instanceVariableNames: 'position length' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !ParseStack commentStamp: '<historical>' prior: 0! + I keep track of the current and high position of the stack that will be needed by code being compiled.! Item was added: + ----- Method: ParseStack>>init (in category 'initialize-release') ----- + init + + length := position := 0! Item was added: + ----- Method: ParseStack>>pop: (in category 'accessing') ----- + pop: n + + (position := position - n) < 0 + ifTrue: [self error: 'Parse stack underflow']! Item was added: + ----- Method: ParseStack>>position (in category 'results') ----- + position + + ^position! Item was added: + ----- Method: ParseStack>>position: (in category 'accessing') ----- + position: n + (position := n) > length + ifTrue: [length := position]! Item was added: + ----- Method: ParseStack>>printOn: (in category 'printing') ----- + printOn: aStream + + super printOn: aStream. + aStream nextPutAll: ' at '; print: position; nextPutAll: ' of '; print: length! Item was added: + ----- Method: ParseStack>>push: (in category 'accessing') ----- + push: n + + (position := position + n) > length + ifTrue: [length := position]! Item was added: + ----- Method: ParseStack>>size (in category 'accessing') ----- + size + + ^length! Item was added: + Scanner subclass: #Parser + instanceVariableNames: 'here hereType hereMark hereEnd prevMark prevEnd encoder parseNode failBlock requestorOffset tempsMark doitFlag properties queriedUnusedTemporaries cue' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !Parser commentStamp: 'cwp 12/26/2012 23:34' prior: 0! + I parse Smalltalk syntax and create a MethodNode that is the root of the parse tree. I look one token ahead.! Item was added: + ----- Method: Parser class>>primitivePragmaSelectors (in category 'accessing') ----- + primitivePragmaSelectors + "Answer the selectors of pragmas that specify VM primitives. + Needed for compile and decomple." + ^#(primitive: + primitive:error: + primitive:error:module: + primitive:module: + primitive:module:error:)! Item was added: + ----- Method: Parser>>addComment (in category 'private') ----- + addComment + + parseNode ~~ nil + ifTrue: + [parseNode comment: currentComment. + currentComment := nil]! Item was added: + ----- Method: Parser>>addPragma: (in category 'pragmas') ----- + addPragma: aPragma + properties := self properties copyWith: aPragma! Item was added: + ----- Method: Parser>>addWarning: (in category 'error handling') ----- + addWarning: aString + "ignored by the default compiler."! Item was added: + ----- Method: Parser>>advance (in category 'scanning') ----- + advance + | this | + prevMark := hereMark. + prevEnd := hereEnd. + this := here. + here := token. + hereType := tokenType. + hereMark := mark. + hereEnd := source position - (aheadChar == DoItCharacter + ifTrue: [hereChar == DoItCharacter + ifTrue: [0] + ifFalse: [1]] + ifFalse: [2]). + self scanToken. + "Transcript show: 'here: ', here printString, ' mark: ', hereMark printString, ' end: ', hereEnd printString; cr." + ^this! Item was added: + ----- Method: Parser>>allocateLiteral: (in category 'primitives') ----- + allocateLiteral: lit + encoder litIndex: lit! Item was added: + ----- Method: Parser>>allowUnderscoreAssignments (in category 'private') ----- + allowUnderscoreAssignments + "Query class + preference" + ^ (encoder ifNotNil: [:e | + e == self + ifTrue: [nil] + ifFalse: [e classEncoding allowUnderscoreAssignments]]) + ifNil: [super allowUnderscoreAssignments]! Item was added: + ----- Method: Parser>>ambiguousSelector:inRange: (in category 'error correction') ----- + ambiguousSelector: aString inRange: anInterval + | correctedSelector intervalWithOffset | + + self interactive ifFalse: [ + "In non interactive mode, compile with backward comapatibility: $- is part of literal argument" + Transcript cr; store: encoder classEncoding; nextPutAll:#'>>';store: encoder selector; show: ' would send ' , token , '-'. + ^super ambiguousSelector: aString inRange: anInterval]. + + "handle the text selection" + intervalWithOffset := anInterval first + requestorOffset to: anInterval last + requestorOffset. + self selectFrom: intervalWithOffset first to: intervalWithOffset last + during: + ["Build the menu with alternatives" + correctedSelector := AmbiguousSelector + signalName: aString + inRange: intervalWithOffset. + correctedSelector ifNil: [^self fail]]. + + "Execute the selected action" + self substituteWord: correctedSelector wordInterval: intervalWithOffset offset: 0. + token := (correctedSelector readStream upTo: Character space) asSymbol! Item was added: + ----- Method: Parser>>argumentName (in category 'expression types') ----- + argumentName + + hereType == #word + ifFalse: [^self expected: 'Argument name']. + ^self advance! Item was added: + ----- Method: Parser>>assignment: (in category 'expression types') ----- + assignment: varNode + " var ':=' expression => AssignmentNode." + | loc start | + (loc := varNode assignmentCheck: encoder at: prevMark + requestorOffset) >= 0 + ifTrue: [^self notify: 'Cannot store into' at: loc]. + start := self startOfNextToken. + self advance. + self expression ifFalse: [^self expected: 'Expression']. + parseNode := AssignmentNode new + variable: varNode + value: parseNode + from: encoder + sourceRange: (start to: self endOfLastToken). + varNode nowHasDef. + ^true! Item was added: + ----- Method: Parser>>bindArg: (in category 'temps') ----- + bindArg: name + + ^ self bindTemp: name! Item was added: + ----- Method: Parser>>bindTemp: (in category 'temps') ----- + bindTemp: name + + ^name! Item was added: + ----- Method: Parser>>bindTemp:in: (in category 'temps') ----- + bindTemp: name in: methodSelector + + ^name! Item was added: + ----- Method: Parser>>blockExpression (in category 'expression types') ----- + blockExpression + "[ ({:var} |) (| {temps} |) (statements) ] => BlockNode." + + | blockNode variableNodes temporaryBlockVariables start | + blockNode := BlockNode new. + variableNodes := OrderedCollection new. + start := prevMark + requestorOffset. + "Gather parameters." + [self match: #colon] whileTrue: + [variableNodes addLast: (encoder bindBlockArg: self argumentName within: blockNode)]. + (variableNodes size > 0 & (hereType ~~ #rightBracket) and: [(self match: #verticalBar) not]) ifTrue: + [^self expected: 'Vertical bar']. + + temporaryBlockVariables := self temporaryBlockVariablesFor: blockNode. + self statements: variableNodes innerBlock: true blockNode: blockNode. + blockNode temporaries: temporaryBlockVariables. + + (self match: #rightBracket) ifFalse: [^self expected: 'Period or right bracket']. + + blockNode noteSourceRangeStart: start end: self endOfLastToken encoder: encoder. + + "The scope of the parameters and temporary block variables is no longer active." + temporaryBlockVariables do: [:variable | variable scope: -1]. + variableNodes do: [:variable | variable scope: -1]! Item was added: + ----- Method: Parser>>braceExpression (in category 'expression types') ----- + braceExpression + " { elements } => BraceNode." + + | elements locations loc more | + elements := OrderedCollection new. + locations := OrderedCollection new. + self advance. + more := hereType ~~ #rightBrace. + [more] + whileTrue: + [loc := hereMark + requestorOffset. + self expression + ifTrue: + [elements addLast: parseNode. + locations addLast: loc] + ifFalse: + [^self expected: 'Variable or expression or right brace']. + (self match: #period) + ifTrue: [more := hereType ~~ #rightBrace] + ifFalse: [more := false]]. + parseNode := BraceNode new elements: elements sourceLocations: locations. + (self match: #rightBrace) + ifFalse: [^self expected: 'Period or right brace']. + ^true! Item was added: + ----- Method: Parser>>canDeclareClassVariable (in category 'error correction') ----- + canDeclareClassVariable + ^encoder classEncoding ~~ UndefinedObject! Item was added: + ----- Method: Parser>>canDeclareInstanceVariable (in category 'error correction') ----- + canDeclareInstanceVariable + ^encoder classEncoding ~~ UndefinedObject! Item was added: + ----- Method: Parser>>cascade (in category 'expression types') ----- + cascade + " {; message} => CascadeNode." + + | rcvr msgs | + parseNode canCascade ifFalse: + [^self expected: 'Cascading not']. + parseNode ensureCanCascade: encoder. + rcvr := parseNode cascadeReceiver. + msgs := OrderedCollection with: parseNode. + [self match: #semicolon] + whileTrue: + [parseNode := rcvr. + (self messagePart: 3 repeat: false) + ifFalse: [^self expected: 'Cascade']. + parseNode canCascade ifFalse: + [^self expected: '<- No special messages']. + parseNode ensureCanCascade: encoder. + parseNode cascadeReceiver. + msgs addLast: parseNode]. + parseNode := CascadeNode new receiver: rcvr messages: msgs! Item was added: + ----- Method: Parser>>collectTemporaryDeclarationsFrom: (in category 'error correction') ----- + collectTemporaryDeclarationsFrom: methodNode + | tempsMarks str | + tempsMarks := OrderedCollection new. + str := cue requestor text asString. + methodNode accept: (ParseNodeEnumerator + ofBlock: [ :aNode | + | mark | + (aNode class canUnderstand: #tempsMark) + ifTrue: + [mark := aNode tempsMark. + (mark notNil and: [ mark between: 1 and: str size ] and: [ (str at: mark) = $| ]) + ifTrue: [ tempsMarks addLast: aNode ]]]). + (tempsMark notNil and: [ tempsMark between: 1 and: str size ] and: [ (str at: tempsMark) = $| ]) + ifTrue: [ tempsMarks addLast: self ]. + ^ tempsMarks sorted: [ :a :b | a tempsMark > b tempsMark ]! Item was added: + ----- Method: Parser>>correctSelector:wordIntervals:exprInterval:ifAbort: (in category 'error correction') ----- + correctSelector: proposedKeyword wordIntervals: spots exprInterval: expInt ifAbort: abortAction + "Correct the proposedKeyword to some selector symbol, correcting the original text if such action is indicated. abortAction is invoked if the proposedKeyword couldn't be converted into a valid selector. Spots is an ordered collection of intervals within the test stream of the for each of the keyword parts." + + | correctSelector | + "If we can't ask the user, assume that the keyword will be defined later" + self interactive ifFalse: [^ proposedKeyword asSymbol]. + + self selectFrom: spots first first to: spots last last during: [ + correctSelector := UnknownSelector name: proposedKeyword. + correctSelector ifNil: [^ abortAction value]]. + + self substituteSelector: correctSelector keywords wordIntervals: spots. + ^ (proposedKeyword last ~~ $: + and: [correctSelector last == $:]) + ifTrue: [abortAction value] + ifFalse: [correctSelector]! Item was added: + ----- Method: Parser>>correctVariable:interval: (in category 'error correction') ----- + correctVariable: proposedVariable interval: spot + "Correct the proposedVariable to a known variable, or declare it as a new + variable if such action is requested. We support declaring lowercase + variables as temps or inst-vars, and uppercase variables as Globals or + ClassVars, depending on whether the context is nil (class=UndefinedObject). + Spot is the interval within the test stream of the variable." + + | binding action | + "Check if this is an i-var, that has been corrected already (ugly)" + (encoder classEncoding instVarNames includes: proposedVariable) ifTrue: + [^InstanceVariableNode new + name: proposedVariable + index: (encoder classEncoding allInstVarNames indexOf: proposedVariable)]. + + "First check to see if the requestor knows anything about the variable" + (binding := cue requestor ifNotNil: [:object | object bindingOf: proposedVariable]) + ifNotNil: [^encoder global: binding name: proposedVariable]. + + "If we can't ask the user for correction, make it undeclared" + self interactive ifFalse: [^encoder undeclared: proposedVariable]. + + self selectFrom: spot first to: spot last + during: + ["Build the menu with alternatives" + action := UndeclaredVariable + signalFor: self + name: proposedVariable + inRange: spot. + action ifNil: [^self fail]]. + + "Execute the selected action" + ^action value! Item was added: + ----- Method: Parser>>declareClassVar: (in category 'error correction') ----- + declareClassVar: name + | sym class | + sym := name asSymbol. + class := encoder classEncoding. + class := class theNonMetaClass. "not the metaclass" + class addClassVarName: name. + Smalltalk logChange: class definition. + ^ encoder global: (class classPool associationAt: sym) + name: sym! Item was added: + ----- Method: Parser>>declareGlobal: (in category 'error correction') ----- + declareGlobal: name + | sym | + sym := name asSymbol. + ^encoder + global: (encoder environment + at: sym put: nil; + associationAt: sym) + name: sym! Item was added: + ----- Method: Parser>>declareInstVar: (in category 'error correction') ----- + declareInstVar: name + "Declare an instance variable. Since the variable will get added after any existing + inst vars its index is the instSize." + encoder classEncoding addInstVarName: name. + Smalltalk logChange: encoder classEncoding definition. + ^InstanceVariableNode new name: name index: encoder classEncoding instSize + ! Item was added: + ----- Method: Parser>>declareTemp:at: (in category 'error correction') ----- + declareTemp: name at: levelTag + "Defer declaring the temp until the parse has completed. This allows + the parser to declare the temp in the minimum enclosing block instead + of always at method level. See Parser>>declareUndeclaredTemps:" + ^(encoder bindUndeclaredTemp: name) + tag: levelTag; + yourself! Item was added: + ----- Method: Parser>>declareTempAndPaste: (in category 'error correction') ----- + declareTempAndPaste: name + "Defer declaring the temp until the parse has completed. This allows + the parser to declare the temp in the minimum enclosing block instead + of always at method level. See Parser>>declareUndeclaredTemps:" + ^encoder bindUndeclaredTemp: name! Item was added: + ----- Method: Parser>>declareUndeclaredTemps: (in category 'error correction') ----- + declareUndeclaredTemps: methodNode + "Declare any undeclared temps, declaring them at the smallest enclosing scope." + + | undeclared blocksToVars | + (undeclared := encoder undeclaredTemps) isEmpty ifTrue: + [^self]. + blocksToVars := IdentityDictionary new. + undeclared do: + [:var| + (blocksToVars + at: (var tag == #method + ifTrue: [methodNode block] + ifFalse: [methodNode accept: (VariableScopeFinder new ofVariable: var)]) + ifAbsentPut: [SortedCollection new]) add: var name]. + (blocksToVars removeKey: methodNode block ifAbsent: []) ifNotNil: + [:rootVars| + rootVars do: [:varName| self pasteTempAtMethodLevel: varName]]. + (blocksToVars keys sorted: [:a :b| a tempsMark < b tempsMark]) do: + [:block| | decl | + decl := (blocksToVars at: block) reduce: [:a :b| a, ' ', b]. + block temporaries isEmpty + ifTrue: + [self substituteWord: ' | ', decl, ' |' + wordInterval: (block tempsMark + 1 to: block tempsMark) + offset: requestorOffset] + ifFalse: + [self substituteWord: decl, ' ' + wordInterval: (block tempsMark to: block tempsMark - 1) + offset: requestorOffset]]. + ReparseAfterSourceEditing signal! Item was added: + ----- Method: Parser>>defineClass: (in category 'error correction') ----- + defineClass: className + "prompts the user to define a new class, + asks for it's category, and lets the users edit further + the definition" + | sym cat def d2 | + sym := className asSymbol. + cat := Project uiManager request: 'Enter class category : ' initialAnswer: self encoder classEncoding theNonMetaClass category. + cat + ifEmpty: [cat := 'Unknown']. + def := 'Object subclass: #' , sym , ' + instanceVariableNames: '''' + classVariableNames: '''' + poolDictionaries: '''' + category: ''' , cat , ''''. + d2 := Project uiManager request: 'Edit class definition : ' initialAnswer: def. + d2 + ifEmpty: [d2 := def]. + Compiler evaluate: d2. + ^ encoder + global: (cue environment bindingOf: sym) + name: sym! Item was added: + ----- Method: Parser>>encoder (in category 'private') ----- + encoder + ^encoder ifNil: + [encoder := CompiledMethod preferredBytecodeSetEncoderClass new]! Item was added: + ----- Method: Parser>>encoderClass: (in category 'public access') ----- + encoderClass: anEncoderClass + encoder ifNotNil: [ + self error: 'encoder already set']. + encoder := anEncoderClass new! Item was added: + ----- Method: Parser>>encoderFromCue: (in category 'private') ----- + encoderFromCue: aCompilationCue + ^encoder ifNil: + [encoder := (aCompilationCue encoderClass ifNil: [CompiledMethod preferredBytecodeSetEncoderClass]) new]! Item was added: + ----- Method: Parser>>endOfLastToken (in category 'scanning') ----- + endOfLastToken + + ^ prevEnd ifNil: [mark]! Item was added: + ----- Method: Parser>>expected: (in category 'error handling') ----- + expected: aString + "Notify a problem at token 'here'." + + ^ self notify: aString , ' expected' at: hereMark + requestorOffset! Item was added: + ----- Method: Parser>>expression (in category 'expression types') ----- + expression + (hereType == #word + and: [tokenType == #leftArrow]) ifTrue: + [^self assignment: self variable]. + self primaryExpression ifFalse: + [^false]. + ((self messagePart: 3 repeat: true) + and: [hereType == #semicolon]) ifTrue: + [self cascade]. + ^true! Item was added: + ----- Method: Parser>>fail (in category 'error handling') ----- + fail + + | exitBlock | + (encoder == nil or: [encoder == self]) + ifFalse: [encoder release. encoder := nil]. "break cycle" + exitBlock := failBlock. + failBlock := nil. + ^exitBlock value! Item was added: + ----- Method: Parser>>init:cue:failBlock: (in category 'private') ----- + init: sourceStream cue: aCue failBlock: aBlock + + self setCue: aCue. + failBlock := aBlock. + requestorOffset := 0. + super scan: sourceStream. + prevMark := hereMark := mark. + self advance + ! Item was added: + ----- Method: Parser>>initPattern:return: (in category 'private') ----- + initPattern: aString return: aBlock + + | result | + self + init: (ReadStream on: aString asString) + cue: (CompilationCue source: aString) + failBlock: [^nil]. + encoder := self. + result := aBlock value: (self pattern: false inContext: nil). + encoder := failBlock := nil. "break cycles" + ^result! Item was added: + ----- Method: Parser>>interactive (in category 'error handling') ----- + interactive + "The compilation is interactive if there is a requestor and that requestor does either not care or explicitly allow interactive error correction." + + ^ cue requestor notNil + and: [(cue requestor respondsTo: #wantsInteractiveErrorCorrection) not + or: [cue requestor perform: #wantsInteractiveErrorCorrection]]! Item was added: + ----- Method: Parser>>match: (in category 'scanning') ----- + match: type + "Answer with true if next tokens type matches." + + hereType == type + ifTrue: + [self advance. + ^true]. + ^false! Item was added: + ----- Method: Parser>>matchReturn (in category 'scanning') ----- + matchReturn + + ^ self match: #upArrow! Item was added: + ----- Method: Parser>>matchToken: (in category 'scanning') ----- + matchToken: thing + "Matches the token, not its type." + + here = thing ifTrue: [self advance. ^true]. + ^false! Item was added: + ----- Method: Parser>>messagePart:repeat: (in category 'expression types') ----- + messagePart: level repeat: repeat + + | start receiver selector args precedence words keywordStart | + [receiver := parseNode. + (hereType == #keyword and: [level >= 3]) + ifTrue: + [start := self startOfNextToken. + selector := WriteStream on: (String new: 32). + args := OrderedCollection new. + words := OrderedCollection new. + [hereType == #keyword] + whileTrue: + [keywordStart := self startOfNextToken + requestorOffset. + selector nextPutAll: self advance. + words addLast: (keywordStart to: self endOfLastToken + requestorOffset). + self primaryExpression ifFalse: [^self expected: 'Argument']. + self messagePart: 2 repeat: true. + args addLast: parseNode]. + selector := (Symbol lookup: selector contents) + ifNil: [ self correctSelector: selector contents + wordIntervals: words + exprInterval: (start to: self endOfLastToken) + ifAbort: [ ^ self fail ] ]. + precedence := 3] + ifFalse: [ + (level >= 2 and: [hereType == #verticalBar]) ifTrue: [self transformAVerticalBarIntoABinarySelector]. + (hereType == #binary and: [level >= 2]) + ifTrue: + [start := self startOfNextToken. + selector := self advance asOctetString asSymbol. + self primaryExpression ifFalse: [^self expected: 'Argument']. + self messagePart: 1 repeat: true. + args := Array with: parseNode. + precedence := 2] + ifFalse: [hereType == #word + ifTrue: + [start := self startOfNextToken. + selector := self advance. + args := #(). + words := OrderedCollection with: (start + requestorOffset to: self endOfLastToken + requestorOffset). + selector := (Symbol lookup: selector) + ifNil: [ self correctSelector: selector + wordIntervals: words + exprInterval: (start to: self endOfLastToken) + ifAbort: [ ^ self fail ] ]. + precedence := 1] + ifFalse: [^args notNil]]]. + parseNode := MessageNode new + receiver: receiver + selector: selector + arguments: args + precedence: precedence + from: encoder + sourceRange: (start to: self endOfLastToken). + repeat] + whileTrue: []. + ^true! Item was added: + ----- Method: Parser>>method:context: (in category 'expression types') ----- + method: doit context: ctxt + " pattern [ | temporaries ] block => MethodNode." + + | sap blk prim temps messageComment methodNode | + sap := self pattern: doit inContext: ctxt. + "sap={selector, arguments, precedence}" + self properties selector: (sap at: 1). + encoder selector: (sap at: 1). + (sap at: 2) do: [:argNode | argNode beMethodArg]. + doit ifFalse: [self pragmaSequence]. + temps := self temporaries. + messageComment := currentComment. + currentComment := nil. + doit ifFalse: [self pragmaSequence]. + prim := self pragmaPrimitives. + self statements: #() innerBlock: false blockNode: BlockNode new. + blk := parseNode. + doit ifTrue: [blk returnLast] + ifFalse: [blk returnSelfIfNoOther: encoder]. + hereType == #doIt ifFalse: [^self expected: 'Nothing more']. + methodNode := self newMethodNode comment: messageComment. + methodNode + selector: (sap at: 1) + arguments: (sap at: 2) + precedence: (sap at: 3) + temporaries: temps + block: blk + encoder: encoder + primitive: prim + properties: properties. + self interactive ifTrue: + [self declareUndeclaredTemps: methodNode. + self removeUnusedTemps: methodNode]. + ^methodNode! Item was added: + ----- Method: Parser>>newMethodNode (in category 'expression types') ----- + newMethodNode + ^self encoder methodNodeClass new! Item was added: + ----- Method: Parser>>notify: (in category 'error handling') ----- + notify: aString + "Notify problem at token before 'here'." + + ^self notify: aString at: prevMark + requestorOffset! Item was added: + ----- Method: Parser>>notify:at: (in category 'error handling') ----- + notify: string at: location + | messageText | + messageText := '"' , string , ' ->"'. + cue requestor isNil + ifTrue: [ + | notification | + (encoder == self or: [encoder isNil]) + ifTrue: [^ self fail "failure setting up syntax error"]. + (notification := SyntaxErrorNotification + cue: (cue copy + source: (source contents asText + copyReplaceFrom: location + to: location - 1 + with: messageText); + yourself) + doitFlag: doitFlag + errorMessage: string + location: location) signal. + notification tryNewSourceIfAvailable] + ifFalse: [cue requestor + notify: messageText + at: location + in: source]. + ^ self fail! Item was added: + ----- Method: Parser>>offEnd: (in category 'error handling') ----- + offEnd: aString + "Notify a problem beyond 'here' (in lookAhead token). Don't be offEnded!!" + + requestorOffset == nil + ifTrue: [^ self notify: aString at: mark] + ifFalse: [^ self notify: aString at: mark + requestorOffset] + ! Item was added: + ----- Method: Parser>>parse:class: (in category 'public access') ----- + parse: sourceStreamOrString class: behavior + + ^ self parse: sourceStreamOrString readStream class: behavior + noPattern: false notifying: nil ifFail: [^nil]! Item was added: + ----- Method: Parser>>parse:class:noPattern:notifying:ifFail: (in category 'public access') ----- + parse: sourceStream class: class noPattern: noPattern notifying: req ifFail: aBlock + | c | + c := CompilationCue + source: sourceStream + class: class + requestor: req. + ^ self + parseCue: c + noPattern: noPattern + ifFail: aBlock! Item was added: + ----- Method: Parser>>parseArgsAndTemps: (in category 'public access') ----- + parseArgsAndTemps: aString + "Parse the argument, aString, answer nil if an error occurs. Otherwise, + answer an Array of strings (the argument names and temporary variable names)." + + aString == nil ifTrue: [^#()]. + doitFlag := false. "Don't really know if a doit or not!!" + ^self initPattern: aString + return: [:pattern | (pattern at: 2) , (self temporariesIn: (pattern at: 1))]! Item was added: + ----- Method: Parser>>parseCue:noPattern:ifFail: (in category 'public access') ----- + parseCue: aCue noPattern: noPattern ifFail: aBlock + "Answer a MethodNode for the argument, sourceStream, that is the root + of a parse tree. Parsing is done with respect to the CompilationCue to + resolve variables, etc. Errors in parsing are reported to the cue's requestor; + otherwise aBlock is evaluated. The argument noPattern is a Boolean that is + true if the the sourceStream does not contain a method header (i.e., for DoIts)." + + | methNode repeatNeeded myStream s p subSelection | + myStream := aCue sourceStream. + [repeatNeeded := false. + p := myStream position. + s := myStream upToEnd. + myStream position: p. + + doitFlag := noPattern. + [(self encoderFromCue: aCue) init: aCue notifying: self. + self init: myStream cue: aCue failBlock: [^aBlock value]. + + subSelection := self interactive and: [cue requestor selectionInterval = (p + 1 to: p + s size)]. + + failBlock:= aBlock. + methNode := self method: noPattern context: cue context] + on: ReparseAfterSourceEditing + do: [ :ex | + repeatNeeded := true. + properties := nil. "Avoid accumulating pragmas and primitives Number" + myStream := ex newSource + ifNil: [subSelection + ifTrue: + [ReadStream + on: cue requestor text string + from: cue requestor selectionInterval first + to: cue requestor selectionInterval last] + ifFalse: + [ReadStream on: cue requestor text string]] + ifNotNil: [:src | myStream := src readStream]]. + repeatNeeded] whileTrue: + [encoder := self encoder class new]. + methNode sourceText: s. + ^methNode! Item was added: + ----- Method: Parser>>parseMethodComment:setPattern: (in category 'public access') ----- + parseMethodComment: aString setPattern: aBlock + "Answer the method comment for the argument, aString. Evaluate aBlock + with the message pattern in the form #(selector, arguments, precedence)." + + self + initPattern: aString + return: aBlock. + currentComment==nil + ifTrue: [^OrderedCollection new] + ifFalse: [^currentComment]! Item was added: + ----- Method: Parser>>parseParameterNames: (in category 'public access') ----- + parseParameterNames: aString + "Answer the parameter names for the argument, aString, which should + parse successfully up to the temporary declaration or the end of the + method header." + + self initScannerForTokenization. + ^self + initPattern: aString + return: [:pattern | pattern at: 2]! Item was added: + ----- Method: Parser>>parseSelector: (in category 'public access') ----- + parseSelector: aString + "Answer the message selector for the argument, aString, which should + parse successfully up to the temporary declaration or the end of the + method header." + + self allowUnderscoreSelectors ifFalse: [self initScannerForTokenization]. + ^self + initPattern: aString + return: [:pattern | pattern at: 1]! Item was added: + ----- Method: Parser>>pasteTempAtMethodLevel: (in category 'error correction') ----- + pasteTempAtMethodLevel: name + | insertion delta theTextString characterBeforeMark | + + theTextString := cue requestor text string. + characterBeforeMark := theTextString at: tempsMark-1 ifAbsent: [$ ]. + (theTextString at: tempsMark) = $| ifTrue: [ + "Paste it before the second vertical bar" + insertion := name, ' '. + characterBeforeMark isSeparator ifFalse: [insertion := ' ', insertion]. + delta := 0. + ] ifFalse: [ + "No bars - insert some with CR, tab" + insertion := '| ' , name , ' |',String cr. + delta := 2. "the bar and CR" + characterBeforeMark = Character tab ifTrue: [ + insertion := insertion , String tab. + delta := delta + 1. "the tab" + ]. + ]. + tempsMark := tempsMark + + (self substituteWord: insertion + wordInterval: (tempsMark to: tempsMark-1) + offset: 0) - delta! Item was added: + ----- Method: Parser>>pattern:inContext: (in category 'expression types') ----- + pattern: fromDoit inContext: ctxt + " unarySelector | binarySelector arg | keyword arg {keyword arg} => + {selector, arguments, precedence}." + | args selector | + doitFlag := fromDoit. + fromDoit ifTrue: + [^ctxt == nil + ifTrue: [{#DoIt. {}. 1}] + ifFalse: [{#DoItIn:. {encoder encodeVariable: encoder doItInContextName}. 3}]]. + + hereType == #word ifTrue: [^ {self advance asSymbol. {}. 1}]. + + (hereType == #binary or: [hereType == #verticalBar]) ifTrue: + [selector := self advance asSymbol. + args := Array with: (encoder bindArg: self argumentName). + ^ {selector. args. 2}]. + + hereType == #keyword ifTrue: + [selector := WriteStream on: (String new: 32). + args := OrderedCollection new. + [hereType == #keyword] whileTrue:[ + selector nextPutAll: self advance. + args addLast: (encoder bindArg: self argumentName). + ]. + ^ {selector contents asSymbol. args. 3}]. + ^self expected: 'Message pattern'! Item was added: + ----- Method: Parser>>possibleVariablesFor: (in category 'error correction') ----- + possibleVariablesFor: proposedVariable + ^encoder possibleVariablesFor: proposedVariable! Item was added: + ----- Method: Parser>>pragmaLiteral: (in category 'pragmas') ----- + pragmaLiteral: selectorSoFar + "Read a pragma literal. As a nicety we allow a variable name (rather + than a literal string) as the second argument to primitive:error:" + + (hereType == #string or: [ hereType == #literal or: [ hereType == #number or: [ hereType == #character ] ] ]) + ifTrue: [ ^ self advance ]. + (here == $# and: [ tokenType == #word ]) + ifTrue: [ ^ self advance ]. + (here == #- and: [ tokenType == #number ]) + ifTrue: [ ^ (self advance; advance) negated ]. + (here = 'true' or: [ here = 'false' or: [ here = 'nil' ] ]) + ifTrue: [ ^ (Scanner new scanTokens: self advance) first ]. + "This nicety allows one to supply a primitive error + temp as a variable name, rather than a string." + ((selectorSoFar beginsWith: 'primitive:') + and: [(selectorSoFar endsWith: 'error:') + and: [hereType == #word]]) ifTrue: + [^self advance]. + ^self expected: 'Literal constant'! Item was added: + ----- Method: Parser>>pragmaPrimitives (in category 'pragmas') ----- + pragmaPrimitives + | primitives | + self properties isEmpty ifTrue: + [^0]. + primitives := properties pragmas select: + [:pragma| + self class primitivePragmaSelectors includes: pragma keyword]. + primitives isEmpty ifTrue: + [^0]. + primitives size > 1 ifTrue: + [^self notify: 'Ambigous primitives']. + ^self perform: primitives first keyword withArguments: primitives first arguments! Item was added: + ----- Method: Parser>>pragmaSequence (in category 'pragmas') ----- + pragmaSequence + "Parse a sequence of method pragmas." + + [ (hereType == #binary and: [self matchToken: #<]) + ifFalse: [ ^ self ]. + self pragmaStatement. + (hereType == #binary and: [self matchToken: #>]) + ifFalse: [ ^ self expected: '>' ] ] repeat! Item was added: + ----- Method: Parser>>pragmaStatement (in category 'pragmas') ----- + pragmaStatement + "Parse a pragma statement. The leading '<' has already been consumed. The 'here' token is the first one in the pragma. Use that token to dispatch to a custom pragma-parsing method if one can be found with a selector that matches it. + + Note that custom pragma parsers need to fulfill two requirements: + - method selector must match the current token as simple getter, + e.g., <apicall: ...> matches #apicall or <primitive: ...> matches #primitive + - method must have pragma <pragmaParser> to be called." + + "0) Early exit" + (hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ]) + ifFalse: [ ^ self expected: 'pragma declaration' ]. + + "1) Do not consider one-word pragmas such as <primitive> and <foobar>. Only keyword pragmas." + here last == $: ifTrue: [ + "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>." + (Symbol lookup: here allButLast) ifNotNil: [:parserSelector | + Parser methodDict at: parserSelector ifPresent: [:parserMethod | + "3) Only call methods that claim to be a custom pragma parser via <pragmaParser>." + (parserMethod hasPragma: #pragmaParser) + ifTrue: [^ self executeMethod: parserMethod]]]]. + + "X) No custom pragma parser found. Use the default one." + ^ self pragmaStatementKeywords! Item was added: + ----- Method: Parser>>pragmaStatementKeywords (in category 'pragmas') ----- + pragmaStatementKeywords + "Read a single pragma statement. Parse all generic pragmas in the form of: <key1: val1 key2: val2 ...> and remember them, including primitives." + + | selector arguments words index keyword | + selector := String new. + arguments := OrderedCollection new. + words := OrderedCollection new. + [ hereType = #keyword or: [ (hereType = #word or: [ hereType = #binary ]) and: [ selector isEmpty ] ] ] whileTrue: [ + index := self startOfNextToken + requestorOffset. + selector := selector , self advance. + words add: (index to: self endOfLastToken + requestorOffset). + (selector last = $: or: [ selector first isLetter not ]) + ifTrue: [ arguments add: (self pragmaLiteral: selector) ] ]. + selector numArgs ~= arguments size + ifTrue: [ ^ self expected: 'pragma argument' ]. + keyword := (Symbol lookup: selector) + ifNil: [ self + correctSelector: selector wordIntervals: words + exprInterval: (words first first to: words last last) + ifAbort: [ ^ self fail ] ]. + self addPragma: (Pragma keyword: keyword arguments: arguments asArray). + ^ true! Item was added: + ----- Method: Parser>>primaryExpression (in category 'expression types') ----- + primaryExpression + hereType == #word + ifTrue: + [parseNode := self variable. + (parseNode isUndefTemp and: [self interactive]) + ifTrue: [self queryUndefined]. + parseNode nowHasRef. + ^ true]. + hereType == #leftBracket + ifTrue: + [self advance. + self blockExpression. + ^true]. + hereType == #leftBrace + ifTrue: + [self braceExpression. + ^true]. + hereType == #leftParenthesis + ifTrue: + [self advance. + self expression ifFalse: [^self expected: 'expression']. + (self match: #rightParenthesis) + ifFalse: [^self expected: 'right parenthesis']. + ^true]. + (hereType == #string or: [hereType == #number or: [hereType == #literal or: [hereType == #character]]]) + ifTrue: + [parseNode := encoder encodeLiteral: self advance. + ^true]. + (here == #- and: [tokenType == #number and: [1 + hereEnd = mark]]) + ifTrue: + [self advance. + parseNode := encoder encodeLiteral: self advance negated. + ^true]. + ^false! Item was added: + ----- Method: Parser>>primitive (in category 'primitives') ----- + primitive + "Pragmas that encode primitive calls are parsed as normal keyword pragmas. This hook exists so that packages do not break primitive-pragma parsing by accident. Instead, this method needs to be replaced intentionally. + + Note that primitive pragmas are special because they will be called back from the parser into the parser. See #pragmaPrimitives. + + Examples: + <primitive: 42> + <primitive: 'primitiveDirectoryCreate' module: 'FilePlugin'> + <primitive: 'primitiveRegisterExternalFill' module: 'B2DPlugin' error: errorCode>" + + <pragmaParser> + ^ self pragmaStatementKeywords! Item was added: + ----- Method: Parser>>primitive: (in category 'primitives') ----- + primitive: anIntegerOrString + "Create indexed primitive." + + ^self primitive: anIntegerOrString error: nil! Item was added: + ----- Method: Parser>>primitive:error: (in category 'primitives') ----- + primitive: anIntegerOrString error: errorCodeVariableOrNil + "Create indexed primitive with optional error code." + + ^anIntegerOrString isInteger + ifTrue: + [errorCodeVariableOrNil ifNotNil: + [encoder floatTemp: (encoder bindTemp: errorCodeVariableOrNil) nowHasDef]. + anIntegerOrString] + ifFalse: + [anIntegerOrString isString + ifTrue: [self primitive: anIntegerOrString module: nil error: errorCodeVariableOrNil] + ifFalse: [self expected: 'Indexed primitive']]! Item was added: + ----- Method: Parser>>primitive:error:module: (in category 'primitives') ----- + primitive: aNameString error: errorCodeVariableOrNil module: aModuleStringOrNil + "Create named primitive with optional error code." + + ^self primitive: aNameString module: aModuleStringOrNil error: errorCodeVariableOrNil! Item was added: + ----- Method: Parser>>primitive:module: (in category 'primitives') ----- + primitive: aNameString module: aModuleStringOrNil + "Create named primitive." + + ^self primitive: aNameString module: aModuleStringOrNil error: nil! Item was added: + ----- Method: Parser>>primitive:module:error: (in category 'primitives') ----- + primitive: aNameString module: aModuleStringOrNil error: errorCodeVariableOrNil + "Create named primitive with optional error code." + | firstLiteral | + (aNameString isString and: [ aModuleStringOrNil isNil or: [ aModuleStringOrNil isString ] ]) + ifFalse: [ ^ self expected: 'Named primitive' ]. + firstLiteral := { aModuleStringOrNil ifNotNil: [aModuleStringOrNil asSymbol]. + aNameString asSymbol. + 0. + 0 }. + (encoder litIndex: firstLiteral) ~= 0 ifTrue: + [self error: 'parser failed to allocate [primitive binding array as first literal']. + firstLiteral beWritableObject. "Undo the read-only setting in litIndex:" + errorCodeVariableOrNil ifNotNil: + [encoder floatTemp: (encoder bindTemp: errorCodeVariableOrNil) nowHasDef]. + ^117! Item was added: + ----- Method: Parser>>properties (in category 'pragmas') ----- + properties + ^ properties ifNil: [ properties := AdditionalMethodState new ]! Item was added: + ----- Method: Parser>>queriedUnusedTemporaries (in category 'accessing') ----- + queriedUnusedTemporaries + + queriedUnusedTemporaries ifNil: + [queriedUnusedTemporaries := Dictionary new]. + ^queriedUnusedTemporaries! Item was added: + ----- Method: Parser>>queryUndefined (in category 'error correction') ----- + queryUndefined + | varStart varName | + varName := parseNode key. + varStart := self endOfLastToken + requestorOffset - varName size + 1. + self selectFrom: varStart to: varStart + varName size - 1 during: [ + (UndefinedVariable name: varName) ifFalse: [^ self fail]].! Item was added: + ----- Method: Parser>>removeEmptyTempDeclarationsFrom: (in category 'error correction') ----- + removeEmptyTempDeclarationsFrom: methodNode + + | sourceCode madeChanges tempsMarkHolder | + sourceCode := cue requestor text asString. + tempsMarkHolder := self collectTemporaryDeclarationsFrom: methodNode. + madeChanges := false. + tempsMarkHolder do: [ :currentBlock | | tempsMarkChar0 tempsMarkChar1 tempsMarkChar2 end start | + tempsMarkChar0 := (sourceCode at: currentBlock tempsMark). + tempsMarkChar1 := (sourceCode at: currentBlock tempsMark - 1). + tempsMarkChar2 := (sourceCode at: currentBlock tempsMark - 2 ifAbsent: []). + (tempsMarkChar0 == $| and: [ tempsMarkChar1 == $| ]) + ifTrue: + [ end := currentBlock tempsMark. + start := end - 1]. + (tempsMarkChar0 == $| and: [ tempsMarkChar1 == $ and: [ tempsMarkChar2 == $| ] ]) + ifTrue: + [ end := currentBlock tempsMark. + start := end - 2]. + + (start notNil and: [ end notNil ]) ifTrue: [ + | lineStart lineEnd | + lineStart := 1 + (sourceCode + lastIndexOf: Character cr + startingAt: start - 1). + lineEnd := sourceCode + indexOf: Character cr + startingAt: end + 1 + ifAbsent: [ sourceCode size ]. + ((sourceCode indexOfAnyOf: CharacterSet nonSeparators startingAt: lineStart) >= start + and: [ (sourceCode indexOfAnyOf: CharacterSet nonSeparators startingAt: end + 1) > lineEnd ]) ifTrue: [ + start := lineStart. + end := lineEnd ]. + cue requestor correctFrom: start to: end with: ''. + madeChanges := true. + currentBlock tempsMark: nil ] ]. + madeChanges ifTrue: [ReparseAfterSourceEditing signal]! Item was added: + ----- Method: Parser>>removeUnusedTemporaryNamed:from:lookingAt:movingTempMarksOf: (in category 'error correction') ----- + removeUnusedTemporaryNamed: temp from: str lookingAt: currentBlock movingTempMarksOf: someBlocks + + | start end | + end := currentBlock tempsMark - 1. + ["Beginning at right temp marker..." + start := end - temp size + 1. + end < temp size or: [ (str at: start) = $| ] + or: [ temp = (str copyFrom: start to: end) + and: [ ((str at: start - 1) = $| | (str at: start - 1) isSeparator) + & ((str at: end + 1) = $| | (str at: end + 1) isSeparator) ] ]] + whileFalse: [ + "Search left for the unused temp" + end := cue requestor nextTokenFrom: end direction: -1 ]. + (end < temp size or: [ (str at: start) = $| ]) + ifFalse: + [(str at: start - 1) = $ + ifTrue: [ start := start - 1 ]. + cue requestor correctFrom: start to: end with: ''. + someBlocks do: [ :aBlock | aBlock tempsMark: aBlock tempsMark - (end - start + 1)]. + ^true ]. + ^false! Item was added: + ----- Method: Parser>>removeUnusedTemps: (in category 'error correction') ----- + removeUnusedTemps: methodNode + "Scan for unused temp names, and prompt the user about the prospect of removing each one found" + + | madeChanges tempsMarkHolder unusedTempNames tempMarkHoldersToChange | + madeChanges := false. + tempMarkHoldersToChange := OrderedCollection new. + tempsMarkHolder := self collectTemporaryDeclarationsFrom: methodNode. + unusedTempNames := encoder unusedTempNames select: + [ :temp | (encoder lookupVariable: temp ifAbsent: [ ]) isUndefTemp + and: [ self queriedUnusedTemporaries at: temp ifAbsentPut: [ + (UnusedVariable name: temp) ifNil: [ ^ self fail ]] ]]. + tempsMarkHolder do: [ :currentBlock | + tempMarkHoldersToChange add: currentBlock. + unusedTempNames do: + [ :temp | + (self + removeUnusedTemporaryNamed: temp + from: cue requestor text asString + lookingAt: currentBlock + movingTempMarksOf: tempMarkHoldersToChange) ifTrue: [ madeChanges := true ]]]. + madeChanges + ifTrue: [ self removeEmptyTempDeclarationsFrom: methodNode. + ReparseAfterSourceEditing signal ]! Item was added: + ----- Method: Parser>>selectFrom:to:during: (in category 'error correction') ----- + selectFrom: start to: stop during: aBlock + "Temporarily focus user attention on a zone of error thru text section. + Then restore original user selection. + Note: the original selection is restored invisibly (not displayed). + This will avoid flickering when chaining multiple corrections." + + | userSelection | + userSelection := cue requestor selectionInterval. + cue requestor selectFrom: start to: stop. + aBlock value. + cue requestor selectIntervalInvisibly: userSelection! Item was added: + ----- Method: Parser>>setCue: (in category 'private') ----- + setCue: aCue + cue := aCue! Item was added: + ----- Method: Parser>>startOfNextToken (in category 'scanning') ----- + startOfNextToken + "Return starting position in source of next token." + + hereType == #doIt ifTrue: [^source position + 1]. + ^hereMark! Item was added: + ----- Method: Parser>>statements:innerBlock: (in category 'expression types') ----- + statements: argNodes innerBlock: inner + + ^self statements: argNodes innerBlock: inner blockNode: BlockNode new! Item was added: + ----- Method: Parser>>statements:innerBlock:blockNode: (in category 'expression types') ----- + statements: argNodes innerBlock: inner blockNode: theBlockNode + + | stmts returns start | + "give initial comment to block, since others trail statements" + theBlockNode comment: currentComment. + currentComment := nil. + stmts := OrderedCollection new. + returns := false. + hereType ~~ #rightBracket ifTrue: + [[theBlockNode startOfLastStatement: (start := self startOfNextToken). + (returns := self matchReturn) + ifTrue: + [self expression ifFalse: + [^self expected: 'Expression to return']. + self addComment. + stmts addLast: (parseNode isReturningIf + ifTrue: [parseNode] + ifFalse: [ReturnNode new + expr: parseNode + encoder: encoder + sourceRange: (start to: self endOfLastToken)])] + ifFalse: + [self expression + ifTrue: + [self addComment. + "if both branches return, following code is unreachable, let's avoid this. + But only if interactive, we don't want to prevent loading of legacy code" + self interactive ifTrue: [returns := parseNode isReturningIf]. + stmts addLast: parseNode] + ifFalse: + [self addComment. + stmts size = 0 ifTrue: + [stmts addLast: + (encoder encodeVariable: + (inner ifTrue: ['nil'] ifFalse: ['self']))]]]. + returns ifTrue: + [self match: #period. + (hereType == #rightBracket or: [hereType == #doIt]) ifFalse: + [^self expected: 'End of block']]. + returns not and: [self match: #period]] whileTrue]. + theBlockNode + arguments: argNodes + statements: stmts + returns: returns + from: encoder. + parseNode := theBlockNode. + ^true! Item was added: + ----- Method: Parser>>substituteSelector:wordIntervals: (in category 'error correction') ----- + substituteSelector: selectorParts wordIntervals: spots + "Substitute the correctSelector into the (presumed interactive) receiver." + | offset | + offset := 0. + selectorParts with: spots do: + [ :word :interval | + offset := self substituteWord: word wordInterval: interval offset: offset ] + ! Item was added: + ----- Method: Parser>>substituteVariable:atInterval: (in category 'error correction') ----- + substituteVariable: each atInterval: anInterval + self + substituteWord: each + wordInterval: anInterval + offset: 0. + ^encoder encodeVariable: each! Item was added: + ----- Method: Parser>>substituteWord:wordInterval:offset: (in category 'error correction') ----- + substituteWord: correctWord wordInterval: spot offset: o + "Substitute the correctSelector into the (presumed interactive) receiver. + Update requestorOffset based on the delta size and answer the updated offset." + + cue requestor correctFrom: spot first + o to: spot last + o with: correctWord. + requestorOffset := requestorOffset + correctWord size - spot size. + ^o + correctWord size - spot size! Item was added: + ----- Method: Parser>>temporaries (in category 'expression types') ----- + temporaries + " [ '|' (variable)* '|' ]" + | vars theActualText | + (self match: #verticalBar) ifFalse: + ["no temps" + doitFlag ifTrue: + [tempsMark := self interactive + ifTrue: [cue requestor selectionInterval first] + ifFalse: [1]. + ^ #()]. + tempsMark := hereMark "formerly --> prevMark + prevToken". + tempsMark > 0 ifTrue: + [theActualText := source contents. + [tempsMark < theActualText size and: [(theActualText at: tempsMark) isSeparator]] + whileTrue: [tempsMark := tempsMark + 1]]. + ^ #()]. + vars := OrderedCollection new. + [hereType == #word] + whileTrue: [vars addLast: (encoder bindTemp: self advance)]. + (self match: #verticalBar) ifTrue: + [tempsMark := prevMark. + ^ vars]. + ^ self expected: 'Vertical bar' + ! Item was added: + ----- Method: Parser>>temporariesIn: (in category 'expression types') ----- + temporariesIn: methodSelector + " [ '|' (variable)* '|' ]" + | vars theActualText | + (self match: #verticalBar) ifFalse: + ["no temps" + doitFlag ifTrue: + [tempsMark := self interactive + ifTrue: [cue requestor selectionInterval first] + ifFalse: [1]. + ^ #()]. + tempsMark := hereMark "formerly --> prevMark + prevToken". + tempsMark > 0 ifTrue: + [theActualText := source contents. + [tempsMark < theActualText size and: [(theActualText at: tempsMark) isSeparator]] + whileTrue: [tempsMark := tempsMark + 1]]. + ^ #()]. + vars := OrderedCollection new. + [hereType == #word] + whileTrue: [vars addLast: (encoder bindTemp: self advance in: methodSelector)]. + (self match: #verticalBar) ifTrue: + [tempsMark := prevMark. + ^ vars]. + ^ self expected: 'Vertical bar'! Item was added: + ----- Method: Parser>>temporaryBlockVariablesFor: (in category 'expression types') ----- + temporaryBlockVariablesFor: aBlockNode + "Scan and answer temporary block variables." + + | variables | + (self match: #verticalBar) ifFalse: + "There are't any temporary variables." + [aBlockNode tempsMark: prevMark + requestorOffset. + ^#()]. + + variables := OrderedCollection new. + [hereType == #word] whileTrue: + [variables addLast: (encoder bindBlockTemp: self advance within: aBlockNode)]. + (self match: #verticalBar) ifFalse: + [^self expected: 'Vertical bar']. + aBlockNode tempsMark: prevMark + requestorOffset. + ^variables! Item was added: + ----- Method: Parser>>tempsMark (in category 'accessing') ----- + tempsMark + ^ tempsMark! Item was added: + ----- Method: Parser>>tempsMark: (in category 'accessing') ----- + tempsMark: aNumber + tempsMark := aNumber! Item was added: + ----- Method: Parser>>transformAVerticalBarIntoABinarySelector (in category 'scanning') ----- + transformAVerticalBarIntoABinarySelector + "Transform a vertical bar into a binary selector. + Eventually aggregate a serie of immediately following vertical bars and a binary selector. + Note that this aggregation cannot occur at scan time, because a pair of vertical bars can be encountered in two valid constructs: + - either as an empty temporaries specification, + - or as a local temporaries specification in a block of arity > 0" + here := '|'. + hereType := #binary. + [tokenType == #verticalBar and: [hereMark + here size = mark]] + whileTrue: [ + here := here , '|'. + hereEnd := hereEnd + 1. + self scanToken]. + (tokenType == #binary and: [hereMark + here size = mark]) + ifTrue: [ + here := here asString , token. + hereType := #binary. + hereEnd := hereEnd + token size. + self scanToken].! Item was added: + ----- Method: Parser>>variable (in category 'expression types') ----- + variable + + | varName varStart varEnd | + varStart := self startOfNextToken + requestorOffset. + varName := self advance. + varEnd := self endOfLastToken + requestorOffset. + ^ encoder encodeVariable: varName + sourceRange: (varStart to: varEnd) + ifUnknown: [self correctVariable: varName interval: (varStart to: varEnd)]! Item was added: + Notification subclass: #ParserNotification + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Exceptions'! Item was added: + ----- Method: ParserNotification class>>name: (in category 'instance creation') ----- + name: aString + ^ (self new setName: aString) signal! Item was added: + ----- Method: ParserNotification>>openMenuIn: (in category 'handling') ----- + openMenuIn: aBlock + self subclassResponsibility! Item was added: + ----- Method: ParserNotification>>setName: (in category 'initialization') ----- + setName: aString + name := aString! Item was added: + TempVariableNode subclass: #RemoteTempVectorNode + instanceVariableNames: 'remoteTemps readNode writeNode' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !RemoteTempVectorNode commentStamp: '<historical>' prior: 0! + I am a node for a vector of remote temps, created to share temps between closures when those temps are written to in closures other than their defining ones.! Item was added: + ----- Method: RemoteTempVectorNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitRemoteTempVectorNode: self! Item was added: + ----- Method: RemoteTempVectorNode>>addRemoteTemp:encoder: (in category 'closure analysis') ----- + addRemoteTemp: aTempVariableNode encoder: encoder + remoteTemps ifNil: + [remoteTemps := OrderedCollection new]. + remoteTemps addLast: aTempVariableNode. + aTempVariableNode referenceScopesAndIndicesDo: + [:scopeBlock "<BlockNode>" :location "<Integer>"| + self addReadWithin: scopeBlock at: location]! Item was added: + ----- Method: RemoteTempVectorNode>>emitCodeForStoreInto:stack:encoder: (in category 'code generation') ----- + emitCodeForStoreInto: aTempVariableNode stack: stack encoder: encoder + encoder + genStoreRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 + inVectorAt: index! Item was added: + ----- Method: RemoteTempVectorNode>>emitCodeForStorePopInto:stack:encoder: (in category 'code generation') ----- + emitCodeForStorePopInto: aTempVariableNode stack: stack encoder: encoder + encoder + genStorePopRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 + inVectorAt: index. + stack pop: 1! Item was added: + ----- Method: RemoteTempVectorNode>>emitCodeForValueOf:stack:encoder: (in category 'code generation') ----- + emitCodeForValueOf: aTempVariableNode stack: stack encoder: encoder + encoder + genPushRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 + inVectorAt: index. + stack push: 1! Item was added: + ----- Method: RemoteTempVectorNode>>isIndirectTempVector (in category 'closure analysis') ----- + isIndirectTempVector + ^true! Item was added: + ----- Method: RemoteTempVectorNode>>nodeToInitialize: (in category 'code generation') ----- + nodeToInitialize: encoder + ^AssignmentNode new + variable: self + value: (NewArrayNode new numElements: remoteTemps size)! Item was added: + ----- Method: RemoteTempVectorNode>>printDefinitionForClosureAnalysisOn: (in category 'printing') ----- + printDefinitionForClosureAnalysisOn: aStream + | refs | + aStream + nextPut: ${; + nextPutAll: key. + definingScope ifNotNil: [definingScope blockExtent ifNotNil: [:be| aStream nextPutAll: ' d@'; print: be first]]. + readingScopes ifNotNil: [ + refs := Set new. + readingScopes do: [:elems| refs addAll: elems]. + refs sorted do: [:read| aStream nextPutAll: ' r@'; print: read]]. + remoteTemps + do: [:rt| rt printDefinitionForClosureAnalysisOn: aStream] + separatedBy: [aStream nextPut: $,; space]. + aStream nextPut: $}! Item was added: + ----- Method: RemoteTempVectorNode>>referenceScopesAndIndicesDo: (in category 'closure analysis') ----- + referenceScopesAndIndicesDo: aBinaryBlock + self shouldNotImplement! Item was added: + ----- Method: RemoteTempVectorNode>>remoteTemps (in category 'accessing') ----- + remoteTemps + ^remoteTemps! Item was added: + ----- Method: RemoteTempVectorNode>>remoteTemps: (in category 'decompiler') ----- + remoteTemps: anArray + remoteTemps := anArray. + anArray do: [:tempNode| tempNode remoteNode: self]! Item was added: + ----- Method: RemoteTempVectorNode>>scope (in category 'code generation') ----- + scope + "Answer scope of temporary variables. + Currently only the following distinctions are made: + 0 outer level: args and user-declared temps + 1 block args and doLimiT temps + -1 a block temp that is no longer active + -2 a block temp that held limit of to:do: + -3 an indirect temp vector" + ^-3! Item was added: + ----- Method: RemoteTempVectorNode>>sizeCodeForStoreInto:encoder: (in category 'code generation') ----- + sizeCodeForStoreInto: aTempVariableNode encoder: encoder + ^encoder + sizeStoreRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 + inVectorAt: index! Item was added: + ----- Method: RemoteTempVectorNode>>sizeCodeForStorePopInto:encoder: (in category 'code generation') ----- + sizeCodeForStorePopInto: aTempVariableNode encoder: encoder + ^encoder + sizeStorePopRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 + inVectorAt: index! Item was added: + ----- Method: RemoteTempVectorNode>>sizeCodeForValueOf:encoder: (in category 'code generation') ----- + sizeCodeForValueOf: aTempVariableNode encoder: encoder + ^encoder + sizePushRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 + inVectorAt: index! Item was added: + Notification subclass: #ReparseAfterSourceEditing + instanceVariableNames: 'newSource' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !ReparseAfterSourceEditing commentStamp: 'nice 9/18/2013 22:05' prior: 0! + A ReparseAfterSourceEditing is a Notification used to restart the syntax parsing phase of a compilation after a source code edition. + + Instance Variables + newSource: <UndefinedObject | String | Text | Stream> + + newSource + - this is the new source code to be used for restarting compilation if non interactive + + In case of interactive compilation, newSource variable is nil because source code edition is performed directly in the source code editor, and the new source code will be picked directly there by the compiler. + + In case of non interactive compilation, source code edition typically occurs in a SyntaxError window popping up. But the compiler has no direct access to this object, so newSource has to be passed by our intermediate. + ! Item was added: + ----- Method: ReparseAfterSourceEditing class>>withNewSource: (in category 'instance creation') ----- + withNewSource: aStringOrStream + ^(self new withNewSource: aStringOrStream) signal! Item was added: + ----- Method: ReparseAfterSourceEditing>>newSource (in category 'accessing') ----- + newSource + ^newSource! Item was added: + ----- Method: ReparseAfterSourceEditing>>withNewSource: (in category 'initialize-release') ----- + withNewSource: aStringOrStream + newSource := aStringOrStream! Item was added: + ParseNode subclass: #ReturnNode + instanceVariableNames: 'expr' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !ReturnNode commentStamp: '<historical>' prior: 0! + I represent an expression of the form ^expr.! Item was added: + ----- Method: ReturnNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitReturnNode: self! Item was added: + ----- Method: ReturnNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + "Note we could do this: + scopeBlock ~~ rootNode block ifTrue: + [scopeBlock noteNonLocalReturn]. + and pass up the flag in <BlockNode>>>analyseTempsWithin:rootNode: + which may be fast but will also give less information the debugger. + For now we consider clean blocks a premature optimization." + self flag: 'consider clean blocks'. + expr analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools! Item was added: + ----- Method: ReturnNode>>asReturnNode (in category 'converting') ----- + asReturnNode! Item was added: + ----- Method: ReturnNode>>code (in category 'code generation') ----- + code + + ^expr code! Item was added: + ----- Method: ReturnNode>>emitCodeForReturn:encoder: (in category 'code generation') ----- + emitCodeForReturn: stack encoder: encoder + + expr emitCodeForReturn: stack encoder: encoder. + pc := encoder pc! Item was added: + ----- Method: ReturnNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + + expr emitCodeForReturn: stack encoder: encoder. + pc := encoder pc! Item was added: + ----- Method: ReturnNode>>expr (in category 'printing') ----- + expr + + ^ expr. + ! Item was added: + ----- Method: ReturnNode>>expr: (in category 'initialize-release') ----- + expr: e + + expr := e! Item was added: + ----- Method: ReturnNode>>expr:encoder:sourceRange: (in category 'initialize-release') ----- + expr: e encoder: encoder sourceRange: range + + expr := e. + encoder noteSourceRange: range forNode: self! Item was added: + ----- Method: ReturnNode>>isReturnSelf (in category 'testing') ----- + isReturnSelf + + ^expr == NodeSelf! Item was added: + ----- Method: ReturnNode>>isSpecialConstant (in category 'testing') ----- + isSpecialConstant + + ^expr isSpecialConstant! Item was added: + ----- Method: ReturnNode>>isVariableReference (in category 'testing') ----- + isVariableReference + + ^expr isVariableReference! Item was added: + ----- Method: ReturnNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + + aStream nextPutAll: '^ '. "make this a preference??" + expr printOn: aStream indent: level. + expr printCommentOn: aStream indent: level! Item was added: + ----- Method: ReturnNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + + aStream nextPutAll: '^ '. "make this a preference??" + expr printWithClosureAnalysisOn: aStream indent: level. + expr printCommentOn: aStream indent: level! Item was added: + ----- Method: ReturnNode>>sizeCodeForReturn: (in category 'code generation') ----- + sizeCodeForReturn: encoder + + ^expr sizeCodeForReturn: encoder! Item was added: + ----- Method: ReturnNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + + ^expr sizeCodeForReturn: encoder! Item was added: + Object subclass: #Scanner + instanceVariableNames: 'source mark hereChar aheadChar token tokenType currentComment buffer typeTable' + classVariableNames: 'AllowBlockArgumentAssignment AllowUnderscoreAssignments AllowUnderscoreSelectors AllowUnicharSymbol DoItCharacter TypeTable' + poolDictionaries: '' + category: 'Compiler-Kernel'! + + !Scanner commentStamp: 'ul 4/3/2011 02:04' prior: 0! + I scan a string or text, picking out Smalltalk syntactic tokens. I look one character ahead. I put each token found into the instance variable, token, and its type (a Symbol) into the variable, tokenType. At the end of the input stream, I pretend to see an endless sequence of special characters called doIts. + + Instance Variables + aheadChar: <Character> + buffer: <WriteStream> + currentComment: <OrderedCollection> + hereChar: <Character> + mark: <Integer> + source: <ReadStream> + token: <Symbol|String|NumberCharacter|Boolean|nil> + tokenType: <Symbol> + typeTable: <Array> + + aheadChar + - the next character in the input stream + + buffer + - a reusable WriteStream on a String which is used for building strings. Shouldn't be used from multiple methods without resetting. + + currentComment + - an OrderedCollection of strings which contain all comments between the current token and the previous token or the beginning of the source. + + hereChar + - the current character + + mark + - the position of the current token in the source stream + + source + - the input stream of characters + + token + - the current token + + tokenType + - the type of the current token. The possible token types are: #binary, #character, #colon, #doIt, #keyword, #leftArrow, #leftBrace, #leftBracket, #leftParenthesis, #literal, #period, #rightBrace, #rightBracket, #rightParenthesis, #semicolon, #string, #upArrow, #verticalBar, #word, #xBinary, #xColon, #xDelimiter, #xDigit, #xDollar, #xDoubleQuote, #xLetter, #xLitQuote, #xSingleQuote, #xUnderscore + + typeTable + - an array that maps each an evaluable tokenType to each character with asciiValue between 0 and 255! Item was added: + ----- Method: Scanner class>>allowBlockArgumentAssignment (in category 'preferences') ----- + allowBlockArgumentAssignment + "Accessor for the system-wide preference" + + <preference: 'Allow block argument assignment.' + category: 'Compiler' + description: 'If enabled, the compiler will allow assignment into block arguments. + This provides backward compatibility with the pre-closure compiler.' + type: #Boolean> + ^AllowBlockArgumentAssignment ifNil: [ false ]! Item was added: + ----- Method: Scanner class>>allowBlockArgumentAssignment: (in category 'preferences') ----- + allowBlockArgumentAssignment: aBoolean + "Accessor for the system-wide preference" + + AllowBlockArgumentAssignment := aBoolean! Item was added: + ----- Method: Scanner class>>allowUnderscoreAsAssignment (in category 'preferences') ----- + allowUnderscoreAsAssignment + "Accessor for the system-wide preference" + <preference: 'Allow underscore assignments' + category: 'Compiler' + description: 'When true, underscore can be used as assignment operator' + type: #Boolean> + ^AllowUnderscoreAssignments ifNil:[true]! Item was added: + ----- Method: Scanner class>>allowUnderscoreAsAssignment: (in category 'preferences') ----- + allowUnderscoreAsAssignment: aBool + "Accessor for the system-wide preference" + AllowUnderscoreAssignments := aBool! Item was added: + ----- Method: Scanner class>>initialize (in category 'initialization') ----- + initialize + + self initializeTypeTable. + "The unicode ending with FFFE or FFFF are non characters and can be used by applications if they wish. + We use last legal unicode 16r10FFFF to encode the end of source stream" + DoItCharacter := Character value: 16r10FFFF! Item was added: + ----- Method: Scanner class>>initializeTypeTable (in category 'initialization') ----- + initializeTypeTable + "self initializeTypeTable" + + | newTable | + newTable := Array new: 256 withAll: #xBinary. "default" + newTable atAll: #(9 10 12 13 32 16ra0) put: #xDelimiter. "tab lf ff cr space nbsp" + newTable atAll: ($0 asciiValue to: $9 asciiValue) put: #xDigit. + + 1 to: 255 + do: [:index | + (Character value: index) isLetter + ifTrue: [newTable at: index put: #xLetter]]. + + newTable at: $" asciiValue put: #xDoubleQuote. + newTable at: $# asciiValue put: #xLitQuote. + newTable at: $$ asciiValue put: #xDollar. + newTable at: $' asciiValue put: #xSingleQuote. + newTable at: $: asciiValue put: #xColon. + newTable at: $( asciiValue put: #leftParenthesis. + newTable at: $) asciiValue put: #rightParenthesis. + newTable at: $. asciiValue put: #period. + newTable at: $; asciiValue put: #semicolon. + newTable at: $[ asciiValue put: #leftBracket. + newTable at: $] asciiValue put: #rightBracket. + newTable at: ${ asciiValue put: #leftBrace. + newTable at: $} asciiValue put: #rightBrace. + newTable at: $^ asciiValue put: #upArrow. + newTable at: $_ asciiValue put: #xUnderscore. + newTable at: $| asciiValue put: #verticalBar. + TypeTable := newTable "bon voyage!!"! Item was added: + ----- Method: Scanner class>>inviolateInstanceVariableNames (in category 'testing') ----- + inviolateInstanceVariableNames + "Answer a list of instance variable names not to be used. (Place holder for real list)" + ^ #('thisContext' 'self')! Item was added: + ----- Method: Scanner class>>isLegalInstVarName: (in category 'testing') ----- + isLegalInstVarName: aString + "Answer whether aString is a legal instance variable name." + + ^ ((self isLiteralSymbol: aString) and: [(aString includes: $:) not]) and: + [(self inviolateInstanceVariableNames includes: aString) not]! Item was added: + ----- Method: Scanner class>>isLiteralSymbol: (in category 'testing') ----- + isLiteralSymbol: aSymbol + "Test whether a symbol can be stored as # followed by its characters. + Symbols created internally with asSymbol may not have this property, + e.g. '3' asSymbol." + + | i ascii type next last | + i := aSymbol size. + i = 0 ifTrue: [^ false]. + + "TypeTable should have been origined at 0 rather than 1 ..." + ascii := (aSymbol at: 1) asciiValue. + type := TypeTable at: ascii ifAbsent: [^false]. + type == #xLetter ifTrue: [ + next := last := nil. + [i > 1] + whileTrue: + [ascii := (aSymbol at: i) asciiValue. + type := TypeTable at: ascii ifAbsent: [^false]. + (type == #xLetter or: [type == #xDigit or: [type == #xColon + and: [ + next == nil + ifTrue: [last := #xColon. true] + ifFalse: [last == #xColon and: [next ~~ #xDigit and: [next ~~ #xColon]]]]]]) + ifFalse: [^ false]. + next := type. + i := i - 1]. + ^ true]. + type == #xBinary ifTrue: + [^(2 to: i) allSatisfy: [:j | + ascii := (aSymbol at: j) asciiValue. + (TypeTable at: ascii ifAbsent: []) == #xBinary]]. + type == #verticalBar ifTrue: [^i = 1]. + ^false! Item was added: + ----- Method: Scanner class>>isMessageSelector: (in category 'testing') ----- + isMessageSelector: aSymbol + "Answer if the argument is a valid message selector. + This is optimized for fast filtering." + | first last sz type | + (sz := aSymbol size) = 0 ifTrue: [^false]. + first := aSymbol at: 1. + last := aSymbol at: sz. + type := TypeTable at: first asciiValue. + + type == #xLetter ifTrue: + ["Alas some people (myself included) do create selectors with an initial capital. + But this is unusual, and it is even rarer for these to be unary selectors, so I think + it is better to exclude class names than include the few exceptions." + (first isUppercase and: [last ~~ $:]) ifTrue: + [^false]. + "Could be unary or keyword, may include underscores if AllowUnderscoreSelectors. + It is possible to be more agressive here, filtering out two successive colons, but I'm lazy" + ^aSymbol allSatisfy: (AllowUnderscoreSelectors + ifTrue: + [last == $: + ifTrue: [[:c| c == $: or: [c == $_ or: [c isAlphaNumeric]]]] + ifFalse: [[:c| c ~~ $: and: [c == $_ or: [c isAlphaNumeric]]]]] + ifFalse: + [last == $: + ifTrue: [[:c| c == $: or: [c isAlphaNumeric]]] + ifFalse: [[:c| c ~~ $: and: [c isAlphaNumeric]]]])]. + + type == #xBinary ifTrue: + [^aSymbol allSatisfy: [:c| c == $| or: [(TypeTable at: c asciiValue) == #xBinary]]]. + + ^type == #xUnderscore + and: [AllowUnderscoreSelectors + and: [self isMessageSelector: aSymbol allButFirst]] + + "| implemented | + implemented := Set new. + self systemNavigation allSelect: [:m| implemented add: m selector. false]. + ^Symbol allSubInstances select: [:s| (implemented includes: s) not and: [self isMessageSelector: s]]" + + "| implemented | + implemented := Set new. + self systemNavigation allSelect: [:m| implemented add: m selector. false]. + ^implemented reject: [:s| self isMessageSelector: s]"! Item was added: + ----- Method: Scanner class>>prefAllowUnderscoreAssignments (in category 'preferences') ----- + prefAllowUnderscoreAssignments + "Accessor for the system-wide preference" + + self deprecated: 'Use #allowUnderscoreAsAssignment'. + ^self allowUnderscoreAsAssignment! Item was added: + ----- Method: Scanner class>>prefAllowUnderscoreAssignments: (in category 'preferences') ----- + prefAllowUnderscoreAssignments: aBool + "Accessor for the system-wide preference" + + self deprecated: 'Use #allowUnderscoreAsAssignment:'. + self allowUnderscoreAsAssignment: aBool! Item was added: + ----- Method: Scanner class>>prefAllowUnderscoreSelectors (in category 'preferences') ----- + prefAllowUnderscoreSelectors + "Accessor for the system-wide preference" + <preference: 'Allow underscore selectors' + category: 'Compiler' + description: 'When true, underscore can be used in selectors and varibable names' + type: #Boolean> + ^AllowUnderscoreSelectors ifNil:[false]! Item was added: + ----- Method: Scanner class>>prefAllowUnderscoreSelectors: (in category 'preferences') ----- + prefAllowUnderscoreSelectors: aBool + "Accessor for the system-wide preference" + AllowUnderscoreSelectors := aBool. + + "Reinitialize String's tokenish character map" + String initialize! Item was added: + ----- Method: Scanner class>>prefAllowUnicharSymbol (in category 'preferences') ----- + prefAllowUnicharSymbol + "Accessor for the system-wide preference" + <preference: 'Allow symbols with unique character like #.' + category: 'Compiler' + description: 'When true, the historical syntax #., #,, or # is allowed.' + type: #Boolean> + ^AllowUnicharSymbol ifNil: [false]! Item was added: + ----- Method: Scanner class>>prefAllowUnicharSymbol: (in category 'preferences') ----- + prefAllowUnicharSymbol: aBoolean + "Accessor for the system-wide preference" + AllowUnicharSymbol := aBoolean! Item was added: + ----- Method: Scanner class>>wellFormedInstanceVariableNameFrom: (in category 'testing') ----- + wellFormedInstanceVariableNameFrom: aString + "Answer a legal instance variable name, derived from aString" + + | cleansedString | + cleansedString := aString select: [:ch | ch isDigit or: [ch isLetter]]. + (cleansedString isEmpty or: [cleansedString first isDigit]) + ifTrue: [cleansedString := 'a', cleansedString] + ifFalse: [cleansedString := cleansedString withFirstCharacterDownshifted]. + + [self isLegalInstVarName: cleansedString] whileFalse: + [cleansedString := cleansedString, 'x']. + ^ cleansedString + + "Scanner wellFormedInstanceVariableNameFrom: '234 xx\ Uml /ler42342380-4'"! Item was added: + ----- Method: Scanner>>advance (in category 'expression types') ----- + advance + + | prevToken | + prevToken := token. + self scanToken. + ^prevToken! Item was added: + ----- Method: Scanner>>allowUnderscoreAssignments (in category 'private') ----- + allowUnderscoreAssignments + "Query preference" + ^self class allowUnderscoreAsAssignment! Item was added: + ----- Method: Scanner>>allowUnderscoreSelectors (in category 'private') ----- + allowUnderscoreSelectors + "Query preference" + ^self class prefAllowUnderscoreSelectors! Item was added: + ----- Method: Scanner>>ambiguousSelector:inRange: (in category 'error handling') ----- + ambiguousSelector: aString inRange: anInterval + "Compile with backward compatibility: $- is part of literal argument.." + + token := token asSymbol. + ^self! Item was added: + ----- Method: Scanner>>initScannerForTokenization (in category 'initialize-release') ----- + initScannerForTokenization + "Use a version of typeTable that doesn't raise xIllegal when enocuntering an _" + | underscoreIndex | + underscoreIndex := typeTable identityIndexOf: #xUnderscore ifAbsent: [^self]. + typeTable := typeTable copy. + typeTable at: underscoreIndex put: #xUnderscoreForTokenization. + typeTable at: (typeTable identityIndexOf: #xLitQuote) put: #xLitQuoteForTokenization! Item was added: + ----- Method: Scanner>>initialize (in category 'initialize-release') ----- + initialize + + super initialize. + buffer := WriteStream on: (String new: 40). + typeTable := TypeTable! Item was added: + ----- Method: Scanner>>notify: (in category 'error handling') ----- + notify: string + "Refer to the comment in Object|notify:." + self error: string! Item was added: + ----- Method: Scanner>>notify:at: (in category 'error handling') ----- + notify: string at: posiiton + "Parser compatible message" + + ^self notify: string ! Item was added: + ----- Method: Scanner>>offEnd: (in category 'error handling') ----- + offEnd: aString + "Parser overrides this" + + ^self notify: aString! Item was added: + ----- Method: Scanner>>scan: (in category 'initialize-release') ----- + scan: inputStream + "Bind the input stream, fill the character buffers and first token buffer." + + source := inputStream. + self step. + self step. + self scanToken! Item was added: + ----- Method: Scanner>>scanAllTokenPositionsInto: (in category 'expression types') ----- + scanAllTokenPositionsInto: aBlock + "Evaluate aBlock with the start and end positions of all separate non-white-space tokens, including comments." + + | lastMark | + lastMark := 1. + [currentComment ifNotNil: + [currentComment do: + [:cmnt| | idx | + idx := source originalContents findLastOccurrenceOfString: cmnt startingAt: lastMark. + (idx > 0 and: [idx < mark]) ifTrue: + [aBlock value: idx - 1 value: (lastMark := idx + cmnt size)]]. + currentComment := nil]. + mark ifNotNil: + [(token == #- + and: [(self typeTableAt: hereChar) == #xDigit]) ifTrue: + [| savedMark | + savedMark := mark. + self scanToken. + token := token negated. + mark := savedMark]. + "Compensate for the fact that the parser uses two character lookahead. Normally we must + remove the extra two characters. But this mustn't happen for the last token at the end of stream." + aBlock + value: mark + value: source position - (aheadChar == DoItCharacter + ifTrue: [hereChar == DoItCharacter + ifTrue: [0] + ifFalse: [1]] + ifFalse: [2])]. + (tokenType == #rightParenthesis + or: [tokenType == #doIt]) ifTrue: + [^self]. + tokenType == #leftParenthesis + ifTrue: + [self scanToken; scanAllTokenPositionsInto: aBlock] + ifFalse: + [(tokenType == #word or: [tokenType == #keyword or: [tokenType == #colon]]) + ifTrue: + [self scanLitWord. + token == #true ifTrue: [token := true]. + token == #false ifTrue: [token := false]. + token == #nil ifTrue: [token := nil]] + ifFalse: + [(token == #- + and: [(self typeTableAt: hereChar) == #xDigit]) + ifTrue: + [self scanToken. + token := token negated]]]. + self scanToken ] repeat! Item was added: + ----- Method: Scanner>>scanFieldNames: (in category 'public access') ----- + scanFieldNames: stringOrArray + "Answer an Array of Strings that are the identifiers in the input string, + stringOrArray. If passed an Array, just answer with that Array, i.e., + assume it has already been scanned." + + | strm | + (stringOrArray isMemberOf: Array) + ifTrue: [^stringOrArray]. + self scan: (ReadStream on: stringOrArray asString). + strm := WriteStream on: (Array new: 10). + [tokenType == #doIt] + whileFalse: + [tokenType == #word ifTrue: [strm nextPut: token]. + self scanToken]. + ^strm contents + + "Scanner new scanFieldNames: 'abc def ghi' ('abc' 'def' 'ghi' )"! Item was added: + ----- Method: Scanner>>scanLitByteVec (in category 'expression types') ----- + scanLitByteVec + | stream | + stream := (ByteArray new: 16) writeStream. + [ tokenType == #rightBracket or: [ tokenType == #doIt ] ] whileFalse: [ + tokenType == #word + ifTrue: [ self scanLitWord ]. + (token isInteger and: [ token between: 0 and: 255 ]) + ifFalse: [ ^ self offEnd: '8-bit integer or right bracket expected' ]. + stream nextPut: token. + self scanToken ]. + token := stream contents! Item was added: + ----- Method: Scanner>>scanLitVec (in category 'expression types') ----- + scanLitVec + | s | + s := WriteStream on: (Array new: 16). + [tokenType == #rightParenthesis or: [tokenType == #doIt]] whileFalse: + [tokenType == #leftParenthesis + ifTrue: + [self scanToken; scanLitVec] + ifFalse: + [(tokenType == #word or: [tokenType == #keyword or: [tokenType == #colon]]) + ifTrue: + [self scanLitWord. + token == #true ifTrue: [token := true]. + token == #false ifTrue: [token := false]. + token == #nil ifTrue: [token := nil]] + ifFalse: + [(token isCharacter and: [tokenType ~~ #character]) + ifTrue: [token := token asSymbol] + ifFalse: [(token == #- + and: [(self typeTableAt: hereChar) == #xDigit]) ifTrue: + [self scanToken. + token := token negated]]]]. + s nextPut: token. + self scanToken]. + token := s contents! Item was added: + ----- Method: Scanner>>scanLitWord (in category 'expression types') ----- + scanLitWord + "Accumulate keywords and asSymbol the result." + + token := (String streamContents: [ :stream | + stream nextPutAll: token. + [ (self typeTableAt: hereChar) == #xLetter ] whileTrue: [ + self xLetter. + stream nextPutAll: token ] ]) asSymbol! Item was added: + ----- Method: Scanner>>scanMessageParts: (in category 'public access') ----- + scanMessageParts: sourceString + "Return an array of the form (comment keyword comment arg comment keyword comment arg comment) for the message pattern of this method. Courtesy of Ted Kaehler, June 1999" + + | coll nonKeywords | + coll := OrderedCollection new. + self scan: (ReadStream on: sourceString asString). + nonKeywords := 0. + [tokenType == #doIt] whileFalse: + [(currentComment == nil or: [currentComment isEmpty]) + ifTrue: [coll addLast: nil] + ifFalse: [coll addLast: currentComment removeFirst. + [currentComment isEmpty] whileFalse: + [coll at: coll size put: (coll last, ' ', currentComment removeFirst)]]. + (token numArgs < 1 or: [token = #| and: [ coll size > 1 ] ]) + ifTrue: [(nonKeywords := nonKeywords + 1) > 1 ifTrue: [^ coll]] + "done with header" + ifFalse: [nonKeywords := 0]. + coll addLast: token. + self scanToken]. + (currentComment == nil or: [currentComment isEmpty]) + ifTrue: [coll addLast: nil] + ifFalse: [coll addLast: currentComment removeFirst. + [currentComment isEmpty] whileFalse: [ + coll at: coll size put: (coll last, ' ', currentComment removeFirst)]]. + ^ coll! Item was added: + ----- Method: Scanner>>scanStringStruct (in category 'expression types') ----- + scanStringStruct + + | s | + s := WriteStream on: (Array new: 16). + [tokenType == #rightParenthesis or: [tokenType == #doIt]] + whileFalse: + [tokenType == #leftParenthesis + ifTrue: + [self scanToken; scanStringStruct] + ifFalse: + [tokenType == #word ifFalse: + [^self error: 'only words and parens allowed']]. + s nextPut: token. + self scanToken]. + token := s contents! Item was added: + ----- Method: Scanner>>scanStringStruct: (in category 'public access') ----- + scanStringStruct: textOrString + "The input is a string whose elements are identifiers and parenthesized + groups of identifiers. Answer an array reflecting that structure, representing + each identifier by an uninterned string." + + self scan: (ReadStream on: textOrString asString). + self scanStringStruct. + ^token + + "Scanner new scanStringStruct: 'a b (c d) (e f g)'"! Item was added: + ----- Method: Scanner>>scanToken (in category 'expression types') ----- + scanToken + + [(tokenType := self typeTableAt: hereChar) == #xDelimiter] + whileTrue: [self step]. "Skip delimiters fast, there almost always is one." + mark := aheadChar == DoItCharacter + ifTrue: [hereChar == DoItCharacter + ifTrue: [source position + 1] + ifFalse: [source position]] + ifFalse: [source position - 1]. + (tokenType at: 1) == $x "x as first letter" + ifTrue: [self perform: tokenType "means perform to compute token & type"] + ifFalse: [token := self step "else just unique the first char"]. + ^token! Item was added: + ----- Method: Scanner>>scanTokenPositionsIn:into: (in category 'public access') ----- + scanTokenPositionsIn: textOrString into: aBlock + "Evaluate aBlock with the start and end positions of all separate non-white-space tokens, including comments, in textOrString." + + self initScannerForTokenization. + source := (ReadStream on: textOrString asString). + self step. + self step. + self scanAllTokenPositionsInto: aBlock + + "| code | + code := ' #( 1 2 #( 3 4 )) 16r123 123 123.0 ', (Scanner sourceCodeAt: #scanTokenPositionsIn:into:). + Scanner new scanTokenPositionsIn: code into: [:start :end| Transcript cr; nextPut: $_; nextPutAll: (code copyFrom: start to: end); nextPut: $_; endEntry]" + + "CodeDiffBuilder buildDisplayPatchFrom: (Scanner sourceCodeAt: #scanTokenPositionsIn:into:) to: ((Scanner sourceCodeAt: #scanTokenPositionsIn:into:) copyReplaceAll: (String with: Character cr) with: '')" + + "CodeDiffBuilder buildDisplayPatchFrom: 'colorTable ^colorTable ifNil: [colorTable _ ST80ColorTable]' to:'colorTable ^colorTable ifNil: [colorTable _ ST80ColorTable]'"! Item was added: + ----- Method: Scanner>>scanTokens: (in category 'public access') ----- + scanTokens: textOrString + "Answer an Array that has been tokenized as though the input text, + textOrString, had appeared between the array delimitors #( and ) in a + Smalltalk literal expression." + + self scan: (ReadStream on: textOrString asString). + self scanLitVec. + ^token + + "Scanner new scanTokens: 'identifier keyword: 8r31 ''string'' .'"! Item was added: + ----- Method: Scanner>>step (in category 'expression types') ----- + step + + | c | + c := hereChar. + hereChar := aheadChar. + source atEnd + ifTrue: [aheadChar := DoItCharacter] + ifFalse: [aheadChar := source next]. + ^c! Item was added: + ----- Method: Scanner>>typeTableAt: (in category 'multi-character scans') ----- + typeTableAt: aCharacter + ^typeTable + at: aCharacter charCode + ifAbsent: + [aCharacter == DoItCharacter + ifTrue: [#doIt] + ifFalse: [#xLetter]]! Item was added: + ----- Method: Scanner>>typedScan:do: (in category 'public access') ----- + typedScan: textOrString do: aBinaryBlock + "Evaluate aBinaryBlock with the token and its type for the first token in input, + mapping literals to type #literal and anything else to type #word." + | theTokensType atNumber theToken | + self initScannerForTokenization. + self scan: (ReadStream on: textOrString asString). + atNumber := hereChar notNil and: [hereChar isDigit]. + theTokensType := tokenType. + theToken := self advance. + (theToken == #- and: [atNumber and: [token isNumber]]) ifTrue: + [theToken := self advance negated]. + theToken isNumber ifTrue: [theTokensType := #number]. + ^aBinaryBlock + value: theToken + value: ((#(number string literal character) includes: theTokensType) + ifTrue: [#literal] + ifFalse: [#word])! Item was added: + ----- Method: Scanner>>typedScanTokens: (in category 'public access') ----- + typedScanTokens: textOrString + "Answer an Array that has been tokenized with literals mapped to literals, + special characters mapped to symbols and variable names and keywords + to strings. This methiod accepts _ (underscore) as an assignment token + irrespective of whether the system prefers := as the assignment token." + | s | + self initScannerForTokenization. + self scan: (ReadStream on: textOrString asString). + s := WriteStream on: (Array new: 16). + [tokenType == #doIt] whileFalse: + [(token == #- + and: [(self typeTableAt: hereChar) == #xDigit]) ifTrue: + [self scanToken. + token := token negated]. + s nextPut: token. + self scanToken]. + ^s contents + + "Scanner new typedScanTokens: (Scanner sourceCodeAt: #typedScanTokens:)"! Item was added: + ----- Method: Scanner>>xBinary (in category 'multi-character scans') ----- + xBinary + + | startOfToken | + tokenType := #binary. + startOfToken := mark. + token := String with: self step. + [(self typeTableAt: hereChar) == #xBinary or: [(self typeTableAt: hereChar) == #verticalBar]] whileTrue: + [(hereChar == $- and: [(self typeTableAt: aheadChar) == #xDigit]) + ifTrue: [^self ambiguousSelector: (token , '-') + inRange: (startOfToken to: source position - 1).]. + token := token, (String with: self step)]. + token := token asSymbol! Item was added: + ----- Method: Scanner>>xColon (in category 'multi-character scans') ----- + xColon + "Allow := for assignment" + + aheadChar == $= ifTrue: + [self step. + tokenType := #leftArrow. + self step. + ^ token := #':=']. + "Otherwise, just do what normal scan of colon would do" + tokenType := #colon. + ^ token := self step asSymbol! Item was added: + ----- Method: Scanner>>xDelimiter (in category 'multi-character scans') ----- + xDelimiter + "Ignore blanks, etc." + + self scanToken! Item was added: + ----- Method: Scanner>>xDigit (in category 'multi-character scans') ----- + xDigit + "Form a number." + + tokenType := #number. + aheadChar == DoItCharacter + ifTrue: [source skip: -1 "Read off the end last time"] + ifFalse: [source skip: -2]. + token := (SqNumberParser on: source) + failBlock: [:errorString :position | self notify: errorString at:position]; + nextNumber. + self step; step! Item was added: + ----- Method: Scanner>>xDollar (in category 'multi-character scans') ----- + xDollar + "Form a Character literal." + + aheadChar == DoItCharacter + ifTrue: + [mark := mark + 1. "Let the notification lie behind the dollar" + ^self offEnd: 'A Character was expected']. + self step. "pass over $" + token := self step. + tokenType := #character! Item was added: + ----- Method: Scanner>>xDoubleQuote (in category 'multi-character scans') ----- + xDoubleQuote + "Collect a comment." + + buffer reset. + self step. + [ hereChar == $" ] whileFalse: [ + hereChar == DoItCharacter ifTrue: [ + ^self offEnd: 'Unmatched comment quote' ]. + buffer nextPut: self step ]. + self step. + (currentComment ifNil: [ + currentComment := OrderedCollection new ]) + add: buffer contents. + self scanToken! Item was added: + ----- Method: Scanner>>xIllegal (in category 'multi-character scans') ----- + xIllegal + "An illegal character was encountered" + self notify: 'Illegal character (char code ' , hereChar charCode , ' ' , hereChar charCode storeStringHex , ')' at: mark! Item was added: + ----- Method: Scanner>>xLetter (in category 'multi-character scans') ----- + xLetter + "Form a word or keyword." + + | type | + buffer reset. + [(type := self typeTableAt: hereChar) == #xLetter + or: [type == #xDigit + or: [type == #xUnderscore and:[self allowUnderscoreSelectors]]]] whileTrue: + [buffer nextPut: self step]. + tokenType := (type == #xColon and: [aheadChar ~~ $=]) + ifTrue: + [buffer nextPut: self step. + "Allow any number of embedded colons in literal symbols" + [(self typeTableAt: hereChar) == #xColon] whileTrue: + [buffer nextPut: self step]. + #keyword] + ifFalse: + [#word]. + token := buffer contents! Item was added: + ----- Method: Scanner>>xLitQuote (in category 'multi-character scans') ----- + xLitQuote + "Symbols and vectors: #(1 (4 5) 2 3) #ifTrue:ifFalse: #'abc'." + | start | + start := mark. + self step. "litQuote" + self scanToken. + tokenType == #leftParenthesis + ifTrue: [self scanToken; scanLitVec. + mark := start + 1. + tokenType == #doIt + ifTrue: [self offEnd: 'Unmatched parenthesis']] + ifFalse: [tokenType == #leftBracket + ifTrue: [self scanToken; scanLitByteVec. + mark := start + 1. + tokenType == #doIt + ifTrue: [self offEnd: 'Unmatched bracket']] + ifFalse: [(tokenType == #word or: [tokenType == #keyword or: [tokenType == #colon]]) + ifTrue: [self scanLitWord] + ifFalse: [(tokenType == #string or: [ tokenType == #verticalBar ]) + ifTrue: [token := token asSymbol] + ifFalse: [tokenType == #binary + ifFalse: [(token isCharacter and: [tokenType ~~ #character and: [self class prefAllowUnicharSymbol]]) + ifTrue: [token := token asSymbol] + ifFalse: [self notify: 'Invalid literal character' at: start + 1]]]]]]. + mark := start. + tokenType := #literal + + "#(Pen) + #Pen + #'Pen' + "! Item was added: + ----- Method: Scanner>>xLitQuoteForTokenization (in category 'multi-character scans') ----- + xLitQuoteForTokenization + "Parse underscores as per the regular parser when following a # symbol, so that e.g. #_WIN32 is correctly tokenized." + | index | + index := typeTable identityIndexOf: #xUnderscoreForTokenization ifAbsent: [^self xLitQuote]. + typeTable at: index put: #xUnderscore. + [self xLitQuote] ensure: + [typeTable at: index put: #xUnderscoreForTokenization]! Item was added: + ----- Method: Scanner>>xSingleQuote (in category 'multi-character scans') ----- + xSingleQuote + "String." + + self step. + buffer reset. + [hereChar == $' + and: [aheadChar == $' + ifTrue: [self step. false] + ifFalse: [true]]] + whileFalse: + [hereChar == DoItCharacter + ifTrue: [^self offEnd: 'Unmatched string quote']. + buffer nextPut: self step]. + self step. + token := buffer contents. + tokenType := #string! Item was added: + ----- Method: Scanner>>xUnderscore (in category 'multi-character scans') ----- + xUnderscore + self allowUnderscoreAssignments ifTrue: + "Figure out if x _foo (no space between _ and foo) should be a selector or assignment." + [(self allowUnderscoreSelectors + and: [#(xLetter xDigit xUnderscore xColon) includes: (self typeTableAt: aheadChar)]) + ifFalse: + [self step. + tokenType := #leftArrow. + ^token := #'_']]. + self allowUnderscoreSelectors ifTrue: + [^self xLetter]. + ^self xIllegal! Item was added: + ----- Method: Scanner>>xUnderscoreForTokenization (in category 'multi-character scans') ----- + xUnderscoreForTokenization + "Parse underscores as assignments so as to be able to correctly tokenize ancient source code." + self step. + tokenType := #leftArrow. + ^token := #'_'! Item was added: + LeafNode subclass: #SelectorNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !SelectorNode commentStamp: '<historical>' prior: 0! + I am a parse tree leaf representing a selector.! Item was added: + ----- Method: SelectorNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitSelectorNode: self! Item was added: + ----- Method: SelectorNode>>emitCode:args:encoder: (in category 'code generation') ----- + emitCode: stack args: nArgs encoder: encoder + + self emitCode: stack + args: nArgs + encoder: encoder + super: false! Item was added: + ----- Method: SelectorNode>>emitCode:args:encoder:super: (in category 'code generation') ----- + emitCode: stack args: nArgs encoder: encoder super: supered + code < Send ifTrue: + [self internalEncodingError]. + stack pop: nArgs. + supered + ifTrue: + [(encoder supportsFullBlocks + and: [encoder generatingFullBlock]) + ifTrue: + [encoder genPushLiteral: (encoder sharableLitIndex: encoder classEncoding). + encoder genSendDirectedSuper: index numArgs: nArgs] + ifFalse: [encoder genSendSuper: index numArgs: nArgs]] + ifFalse: + [encoder genSend: index numArgs: nArgs]! Item was added: + ----- Method: SelectorNode>>emitCodeForEffect:encoder: (in category 'code generation') ----- + emitCodeForEffect: stack encoder: encoder + + self shouldNotImplement! Item was added: + ----- Method: SelectorNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + + self shouldNotImplement! Item was added: + ----- Method: SelectorNode>>emitForEffect:on: (in category 'inappropriate') ----- + emitForEffect: stack on: strm + + self shouldNotImplement! Item was added: + ----- Method: SelectorNode>>emitForValue:on: (in category 'inappropriate') ----- + emitForValue: stack on: strm + + self shouldNotImplement! Item was added: + ----- Method: SelectorNode>>forSuperSend (in category 'code generation') ----- + forSuperSend + "Answer the receiver or a derivative, suitable for use in a super send. + This is overridden by SpecialSelectorNode to return a SelectorNode clone." + ^self! Item was added: + ----- Method: SelectorNode>>internalEncodingError (in category 'private') ----- + internalEncodingError + self error: 'with the split between SelectorNode and SpecialSelectorNode code should never be < Send for normal sends.'! Item was added: + ----- Method: SelectorNode>>isForFFICall (in category 'testing') ----- + isForFFICall + ^key asString includesSubstring: '()/'! Item was added: + ----- Method: SelectorNode>>isPvtSelector (in category 'testing') ----- + isPvtSelector + "Answer if this selector node is a private message selector." + + ^key isPvtSelector! Item was added: + ----- Method: SelectorNode>>key: (in category 'printing') ----- + key: aSelector + "This is for printing of FFI selectors." + key := aSelector! Item was added: + ----- Method: SelectorNode>>key:code:index: (in category 'initialize-release') ----- + key: object code: byte index: idx + + key := object. + code := byte. + index := idx! Item was added: + ----- Method: SelectorNode>>name:key:index:type: (in category 'initialize-release') ----- + name: literal key: object index: i type: type + "For compatibility with Encoder>>name:key:class:type:set:" + ^self key: object index: i type: type! Item was added: + ----- Method: SelectorNode>>printAsFFICallWithArguments:on:indent: (in category 'printing') ----- + printAsFFICallWithArguments: aSequence on: aStream indent: level + aStream nextPutAll: (key copyUpTo: $)). + aSequence + do: [:arg| arg printOn: aStream indent: level] + separatedBy: [aStream nextPutAll: ', ']. + aStream nextPut: $)! Item was added: + ----- Method: SelectorNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + aStream nextPutAll: (key == nil + ifTrue: ['<key==nil>'] + ifFalse: [key])! Item was added: + ----- Method: SelectorNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + aStream nextPutAll: (key == nil + ifTrue: ['<key==nil>'] + ifFalse: [key])! Item was added: + ----- Method: SelectorNode>>reserve: (in category 'code generation') ----- + reserve: encoder + "If this is a yet unused literal of type -code, reserve it." + + index ifNil: + [index := encoder sharableLitIndex: key. + code := Send]! Item was added: + ----- Method: SelectorNode>>resetForBlockGeneration (in category 'code generation') ----- + resetForBlockGeneration + "Reset the receiver to an unassigned state such that its index + in the encoder's literalStream is as yet to be determined." + code := SendType negated. + index := nil! Item was added: + ----- Method: SelectorNode>>sizeCode:args:super: (in category 'code generation') ----- + sizeCode: encoder args: nArgs super: supered + self reserve: encoder. + code < Send ifTrue: + [self internalEncodingError]. + supered ifFalse: + [^encoder sizeSend: index numArgs: nArgs]. + (encoder supportsFullBlocks + and: [encoder generatingFullBlock]) ifTrue: + [^(encoder sizePushLiteral: (encoder sharableLitIndex: encoder classEncoding)) + + (encoder sizeSendDirectedSuper: index numArgs: nArgs)]. + ^encoder sizeSendSuper: index numArgs: nArgs! Item was added: + ----- Method: SelectorNode>>sizeCodeForEffect: (in category 'code generation') ----- + sizeCodeForEffect: encoder + + self shouldNotImplement! Item was added: + ----- Method: SelectorNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + + self shouldNotImplement! Item was added: + Notification subclass: #ShadowedVariableNotification + instanceVariableNames: 'name selector class' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !ShadowedVariableNotification commentStamp: 'ct 2/7/2022 22:18' prior: 0! + I tell interested exception handlers or the Transcript about an attempt to compile a method with a shadowed variable, i.e., a temporary variable that has the same name as an existing instance variable in the subject class. The use and usage of shadowed variables are generally disputed: They can lead to confusion when a temporary variable declaration is missed, but they can also be utilized to make an instance variable unaccessible in a local scope.! Item was added: + ----- Method: ShadowedVariableNotification>>defaultAction (in category 'handling') ----- + defaultAction + + Transcript showln: ('{1} ({2} is shadowed)' translated format: + {self methodClass name , '>>' , self selector. + self variableName}).! Item was added: + ----- Method: ShadowedVariableNotification>>methodClass (in category 'accessing') ----- + methodClass + + ^ class! Item was added: + ----- Method: ShadowedVariableNotification>>name:selector:class: (in category 'initialize-release') ----- + name: aString selector: aSymbolOrNil class: aBehavior + + name := aString. + selector := aSymbolOrNil. + class := aBehavior.! Item was added: + ----- Method: ShadowedVariableNotification>>selector (in category 'accessing') ----- + selector + + ^ selector! Item was added: + ----- Method: ShadowedVariableNotification>>variableName (in category 'accessing') ----- + variableName + + ^ name! Item was added: + LiteralNode subclass: #SpecialLiteralNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! Item was added: + ----- Method: SpecialLiteralNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + stack push: 1. + encoder genPushSpecialLiteral: key! Item was added: + ----- Method: SpecialLiteralNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + ^encoder sizePushSpecialLiteral: key! Item was added: + SelectorNode subclass: #SpecialSelectorNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !SpecialSelectorNode commentStamp: 'eem 8/5/2014 20:18' prior: 0! + A SpecialSelectorNode is a subclass of SelectorNode that handles the special selectors, a high static and/or dynamic frequency set of selectors that are assigned their own bytecodes. Special selectors both save space in the literal frame and allow an interpreter to implement these sends directly for certain classes of receiver and argument, for example the SmallIntegers, a technique known as static receiver prediction.! Item was added: + ----- Method: SpecialSelectorNode>>emitCode:args:encoder:super: (in category 'code generation') ----- + emitCode: stack args: nArgs encoder: encoder super: supered + "Generate a special selector send. + A super send of a special selector must be handled like a normal send. + This is handled in MessageNode>>sizeCodeForValue: by mapping any + SpecialSelectorNodes used in super sends into normal SelectorNodes." + supered ifTrue: [self invalidSuperSendError]. + stack pop: nArgs. + encoder genSendSpecial: code numArgs: nArgs! Item was added: + ----- Method: SpecialSelectorNode>>forSuperSend (in category 'code generation') ----- + forSuperSend + "Answer the receiver or a derivative, suitable for use in a super send." + + "Excuse the code negation nonsense. It is a vestige of a very concise but now + obsolete back-end bytecode encoding scheme. We're working on removing it." + ^SelectorNode new + key: key + code: SendType negated + index: index! Item was added: + ----- Method: SpecialSelectorNode>>invalidSuperSendError (in category 'private') ----- + invalidSuperSendError + self error: 'special selectors can only be used for ordinary sends'! Item was added: + ----- Method: SpecialSelectorNode>>resetForBlockGeneration (in category 'code generation') ----- + resetForBlockGeneration + "Reset the receiver to an unassigned state such that its index + in the encoder's literalStream is as yet to be determined." + index := nil! Item was added: + ----- Method: SpecialSelectorNode>>sizeCode:args:super: (in category 'code generation') ----- + sizeCode: encoder args: nArgs super: supered + "Size a special selector send. + A super send of a special selector must be handled like a normal send. + This is handled in MessageNode>>sizeCodeForValue: by mapping any + SpecialSelectorNodes used in super sends into normal SelectorNodes." + supered ifTrue: [self invalidSuperSendError]. + ^encoder sizeSendSpecial: code numArgs: nArgs! Item was added: + Error subclass: #SyntaxErrorNotification + instanceVariableNames: 'cue doitFlag errorMessage location newSource' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Exceptions'! + + !SyntaxErrorNotification commentStamp: 'ct 10/24/2020 00:01' prior: 0! + A SyntaxErrorNotification is an Exception occuring when compiling a Smalltalk source code with incorrect syntax. + Note that in interactive mode, this exception is not raised because the Compiler will interact directly with source code editor. + The defaultAction is to raise a SyntaxError pop up window so as to enable interactive handling even in non interactive mode. + + Instance Variables + cue: <CompilationCue> + doitFlag: <Boolean> + errorMessage: <String> + location: <Integer> + newSource: <String | Text | Stream | nil> + + cue + - the cue for compilation, including receiver class, optional context, and original source code + + doitFlag + - true if this is a doIt (code to evaluate), false if this is a method (code of a method to be compiled) + + errorMessage + - contains information about the syntax error + + location + - position in the source code where the syntax error occured + + newSource + - eventually hold a source code replacement typically passed by the SyntaxError window! Item was added: + ----- Method: SyntaxErrorNotification class>>cue:doitFlag:errorMessage:location: (in category 'instance creation') ----- + cue: aCue doitFlag: doitFlag errorMessage: errorString location: location + + ^ self new + setCue: aCue + doitFlag: doitFlag + errorMessage: errorString + location: location! Item was added: + ----- Method: SyntaxErrorNotification class>>inClass:withCode:doitFlag:errorMessage:location: (in category 'instance creation') ----- + inClass: aClass withCode: codeString doitFlag: doitFlag errorMessage: errorString location: location + + self deprecated: 'ct: Use #cue:doitFlag:errorMessage:location:'. + ^ self + cue: (CompilationCue source: codeString class: aClass requestor: nil) + doitFlag: doitFlag + errorMessage: errorString + location: location! Item was added: + ----- Method: SyntaxErrorNotification>>context (in category 'accessing') ----- + context + + ^ cue context! Item was added: + ----- Method: SyntaxErrorNotification>>doitFlag (in category 'accessing') ----- + doitFlag + ^doitFlag! Item was added: + ----- Method: SyntaxErrorNotification>>environment (in category 'accessing') ----- + environment + + ^ cue environment! Item was added: + ----- Method: SyntaxErrorNotification>>errorClass (in category 'accessing') ----- + errorClass + + ^ cue getClass! Item was added: + ----- Method: SyntaxErrorNotification>>errorCode (in category 'accessing') ----- + errorCode + + ^ cue source! Item was added: + ----- Method: SyntaxErrorNotification>>errorMessage (in category 'accessing') ----- + errorMessage + ^errorMessage! Item was added: + ----- Method: SyntaxErrorNotification>>isResumable (in category 'accessing') ----- + isResumable + + ^ true! Item was added: + ----- Method: SyntaxErrorNotification>>location (in category 'accessing') ----- + location + ^location! Item was added: + ----- Method: SyntaxErrorNotification>>messageText (in category 'accessing') ----- + messageText + ^ super messageText + ifEmpty: [messageText := self errorCode]! Item was added: + ----- Method: SyntaxErrorNotification>>newSource (in category 'accessing') ----- + newSource + ^newSource! Item was added: + ----- Method: SyntaxErrorNotification>>reparse:notifying:ifFail: (in category 'accessing') ----- + reparse: aString notifying: aController ifFail: failBlock + "Try to parse if aString has correct syntax, but do not evaluate/install any code. + In case of incorrect syntax, execute failBlock and let a Compiler interact with the requestor. + In case of correct syntax, set newSource." + + (doitFlag ifTrue: [nil class] ifFalse: [self errorClass]) newCompiler + compileCue: (cue copy + source: aString; + requestor: aController; + yourself) + noPattern: doitFlag + ifFail: failBlock. + newSource := aString.! Item was added: + ----- Method: SyntaxErrorNotification>>retryWithNewSource: (in category 'handling') ----- + retryWithNewSource: source + "Retry the compilation with new source code. + Assume + - that the signallerContext will tryNewSourceIfAvailable + - the presence of a handler of ReparseAfterSourceEditing on the sender stack" + + newSource := source. + ^ self resume! Item was added: + ----- Method: SyntaxErrorNotification>>setCue:doitFlag:errorMessage:location: (in category 'initialize-release') ----- + setCue: aCue doitFlag: aBoolean errorMessage: errorString location: anInteger + + cue := aCue. + doitFlag := aBoolean. + errorMessage := errorString. + location := anInteger! Item was added: + ----- Method: SyntaxErrorNotification>>tryNewSourceIfAvailable (in category 'accessing') ----- + tryNewSourceIfAvailable + newSource ifNotNil: [ReparseAfterSourceEditing withNewSource: newSource]! Item was added: + VariableNode subclass: #TempVariableNode + instanceVariableNames: 'argType hasRefs hasDefs scope definingScope readingScopes writingScopes remoteNode' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !TempVariableNode commentStamp: '<historical>' prior: 0! + I am a parse tree leaf representing a temporary variable! Item was added: + ----- Method: TempVariableNode>>absorbHoistedTemp: (in category 'closure analysis') ----- + absorbHoistedTemp: aTempVar + "Collapse aTempVar into the receiver, being sure to update any closure analysis." + aTempVar copyScopeAccessTo: self. + aTempVar becomeForward: self! Item was added: + ----- Method: TempVariableNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitTempVariableNode: self! Item was added: + ----- Method: TempVariableNode>>addReadWithin:at: (in category 'closure analysis') ----- + addReadWithin: scopeBlock "<BlockNode>" at: location "<Integer>" + readingScopes ifNil: [readingScopes := Dictionary new]. + (readingScopes at: scopeBlock ifAbsentPut: [Set new]) add: location. + remoteNode ifNotNil: + [remoteNode addReadWithin: scopeBlock at: location]! Item was added: + ----- Method: TempVariableNode>>addWriteWithin:at: (in category 'closure analysis') ----- + addWriteWithin: scopeBlock "<BlockNode>" at: location "<Integer>" + writingScopes ifNil: [writingScopes := Dictionary new]. + (writingScopes at: scopeBlock ifAbsentPut: [Set new]) add: location. + remoteNode ifNotNil: + [remoteNode addReadWithin: scopeBlock at: location]! Item was added: + ----- Method: TempVariableNode>>analyseClosure: (in category 'closure analysis') ----- + analyseClosure: rootNode "<MethodNode>" + "Analyse whether the temporary needs to be made remote + or not, and answer whether it was made remote. + A temp cannot be local if it is written to remotely, + or if it is written to after it is closed-over. An exception + is an inlined block argument that appears to be written + remotely but is actually local to a block." + | latestWrite | + self isBlockArg ifTrue: [^false]. + remoteNode ifNotNil: [^false]. "If already remote, don't remote a second time" + latestWrite := 0. + ((writingScopes notNil + and: [writingScopes associations anySatisfy: [:assoc| + [:blockScope :refs| + refs do: [:write| latestWrite := write max: latestWrite]. + "A temp cannot be local if it is written to remotely." + blockScope actualScope ~~ definingScope actualScope] + value: assoc key value: assoc value]]) + or: [readingScopes notNil + and: [readingScopes associations anySatisfy: [:assoc| + [:blockScope :refs| + "A temp cannot be local if it is written to after it is closed-over." + blockScope actualScope ~~ definingScope actualScope + and: [refs anySatisfy: [:read| read < latestWrite]]] + value: assoc key value: assoc value]]]) ifTrue: + [remoteNode := definingScope addRemoteTemp: self rootNode: rootNode. + ^true]. + ^false! Item was added: + ----- Method: TempVariableNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + self addReadWithin: scopeBlock at: rootNode locationCounter! Item was added: + ----- Method: TempVariableNode>>assignmentCheck:at: (in category 'testing') ----- + assignmentCheck: encoder at: location + ^((self isBlockArg and: [Scanner allowBlockArgumentAssignment not]) + or: [self isMethodArg]) + ifTrue: [location] + ifFalse: [-1]! Item was added: + ----- Method: TempVariableNode>>beBlockArg (in category 'testing') ----- + beBlockArg + argType := #block! Item was added: + ----- Method: TempVariableNode>>beMethodArg (in category 'testing') ----- + beMethodArg + argType := #method! Item was added: + ----- Method: TempVariableNode>>beingAssignedToAnalyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + beingAssignedToAnalyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + self addWriteWithin: scopeBlock at: rootNode locationCounter. + "For analysis of optimized blocks also record the set of temporaries written to + within optimized blocks so that additional writes can be added at locations that + represent subsequent iterations of the loop. e.g. testInlineBlockCollectionSD1" + assignmentPools keysAndValuesDo: + [:outerScopeBlock :set| + "definingScope can be nil in expr in expr ifNil: [:arg|...] expressions because + arg gets its definingScope set when [:arg|...] is analysed." + outerScopeBlock actualScope + = (definingScope + ifNil: [scopeBlock] + ifNotNil: [definingScope actualScope]) ifTrue: + [set add: self]]! Item was added: + ----- Method: TempVariableNode>>copyScopeAccessTo: (in category 'closure analysis') ----- + copyScopeAccessTo: aTempVar + "For absorbHoistedTemp:, copy the receiver's reads and writes into the record in aTempVar." + readingScopes ifNotNil: + [readingScopes keysAndValuesDo: + [:scopeBlock :reads| + reads do: + [:location| + aTempVar addReadWithin: scopeBlock "<BlockNode>" at: location]]]. + writingScopes ifNotNil: + [writingScopes keysAndValuesDo: + [:scopeBlock :writes| + writes do: + [:location| + aTempVar addWriteWithin: scopeBlock "<BlockNode>" at: location]]]! Item was added: + ----- Method: TempVariableNode>>definingScope (in category 'closure analysis') ----- + definingScope + ^definingScope! Item was added: + ----- Method: TempVariableNode>>definingScope: (in category 'closure analysis') ----- + definingScope: scopeBlock "<BlockNode>" + definingScope = scopeBlock ifTrue: [^ self]. "No need to bail" + definingScope ifNotNil: + [self error: 'temp has more than one defining scope. This is probably a parser error']. + definingScope := scopeBlock! Item was added: + ----- Method: TempVariableNode>>emitCodeForStore:encoder: (in category 'code generation') ----- + emitCodeForStore: stack encoder: encoder + remoteNode ~~ nil ifTrue: + [^remoteNode emitCodeForStoreInto: self stack: stack encoder: encoder]. + encoder genStoreTemp: index! Item was added: + ----- Method: TempVariableNode>>emitCodeForStorePop:encoder: (in category 'code generation') ----- + emitCodeForStorePop: stack encoder: encoder + remoteNode ~~ nil ifTrue: + [^remoteNode emitCodeForStorePopInto: self stack: stack encoder: encoder]. + encoder genStorePopTemp: index. + stack pop: 1! Item was added: + ----- Method: TempVariableNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + remoteNode ~~ nil ifTrue: + [^remoteNode emitCodeForValueOf: self stack: stack encoder: encoder]. + encoder genPushTemp: index. + stack push: 1! Item was added: + ----- Method: TempVariableNode>>index: (in category 'closure analysis') ----- + index: anInteger + "For renumbering temps in the closure compiler." + index := anInteger. + code := self code: index type: LdTempType! Item was added: + ----- Method: TempVariableNode>>isArg (in category 'testing') ----- + isArg + ^argType notNil! Item was added: + ----- Method: TempVariableNode>>isBlockArg (in category 'testing') ----- + isBlockArg + ^#block == argType! Item was added: + ----- Method: TempVariableNode>>isDeclaredAtMethodLevel (in category 'testing') ----- + isDeclaredAtMethodLevel + "For the explainer." + ^scope = 0! Item was added: + ----- Method: TempVariableNode>>isDefinedWithinBlockExtent: (in category 'closure analysis') ----- + isDefinedWithinBlockExtent: anInterval + ^anInterval rangeIncludes: definingScope actualScope blockExtent first! Item was added: + ----- Method: TempVariableNode>>isIndirectTempVector (in category 'closure analysis') ----- + isIndirectTempVector + ^false! Item was added: + ----- Method: TempVariableNode>>isMethodArg (in category 'testing') ----- + isMethodArg + ^#method == argType! Item was added: + ----- Method: TempVariableNode>>isReferencedWithinBlockExtent: (in category 'closure analysis') ----- + isReferencedWithinBlockExtent: anInterval + readingScopes ~~ nil ifTrue: + [readingScopes do: + [:set "<Set of <Integer>>"| + set do: + [:location| + (anInterval rangeIncludes: location) ifTrue: + [^true]]]]. + writingScopes ~~ nil ifTrue: + [writingScopes do: + [:set "<Set of <Integer>>"| + set do: + [:location| + (anInterval rangeIncludes: location) ifTrue: + [^true]]]]. + ^false! Item was added: + ----- Method: TempVariableNode>>isRemote (in category 'testing') ----- + isRemote + ^remoteNode notNil! Item was added: + ----- Method: TempVariableNode>>isTemp (in category 'testing') ----- + isTemp + ^ true! Item was added: + ----- Method: TempVariableNode>>isUndefTemp (in category 'testing') ----- + isUndefTemp + ^ hasDefs not! Item was added: + ----- Method: TempVariableNode>>isUnusedTemp (in category 'testing') ----- + isUnusedTemp + ^ hasRefs not! Item was added: + ----- Method: TempVariableNode>>name:index:type:scope: (in category 'initialize-release') ----- + name: varName index: i type: type scope: level + "Only used for initting temporary variables" + hasDefs := hasRefs := false. + scope := level. + ^super name: varName key: varName index: i type: type! Item was added: + ----- Method: TempVariableNode>>nowHasDef (in category 'initialize-release') ----- + nowHasDef + hasDefs := true! Item was added: + ----- Method: TempVariableNode>>nowHasRef (in category 'initialize-release') ----- + nowHasRef + hasRefs := true! Item was added: + ----- Method: TempVariableNode>>printDefinitionForClosureAnalysisOn: (in category 'printing') ----- + printDefinitionForClosureAnalysisOn: aStream + | refs | + aStream + nextPut: ${; + nextPutAll: key. + definingScope ifNotNil: [definingScope blockExtent ifNotNil: [:be| aStream nextPutAll: ' d@'; print: be first]]. + readingScopes notNil ifTrue: + [refs := Set new. + readingScopes do: [:elems| refs addAll: elems]. + refs sorted do: [:read| aStream nextPutAll: ' r@'; print: read]]. + writingScopes notNil ifTrue: + [refs := Set new. + writingScopes do: [:elems| refs addAll: elems]. + refs sorted do: [:write| aStream nextPutAll: ' w@'; print: write]]. + aStream nextPut: $}! Item was added: + ----- Method: TempVariableNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + + aStream nextPutAll: name! Item was added: + ----- Method: TempVariableNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + + aStream nextPutAll: name. + readingScopes notNil ifTrue: + [(readingScopes inject: Set new into: [:them :reads| them addAll: reads. them]) sorted do: + [:location| + aStream space; nextPut: $r; nextPut: $@; print: location]]. + writingScopes notNil ifTrue: + [(writingScopes inject: Set new into: [:them :writes| them addAll: writes. them]) sorted do: + [:location| + aStream space; nextPut: $w; nextPut: $@; print: location]]! Item was added: + ----- Method: TempVariableNode>>referenceScopesAndIndicesDo: (in category 'closure analysis') ----- + referenceScopesAndIndicesDo: aBinaryBlock + "Evaluate aBinaryBlock with all read or write scopes and locations. + This is used to copy the reference information into RemoteTempVectorNodes" + readingScopes ~~ nil ifTrue: + [readingScopes keysAndValuesDo: + [:scopeBlock "<BlockNode>" :set "<Set of <Integer>>"| + set do: [:location| aBinaryBlock value: scopeBlock value: location]]]. + writingScopes ~~ nil ifTrue: + [writingScopes keysAndValuesDo: + [:scopeBlock "<BlockNode>" :set "<Set of <Integer>>"| + set do: [:location| aBinaryBlock value: scopeBlock value: location]]]! Item was added: + ----- Method: TempVariableNode>>remoteNode (in category 'testing') ----- + remoteNode + ^remoteNode! Item was added: + ----- Method: TempVariableNode>>remoteNode: (in category 'decompiler') ----- + remoteNode: aRemoteTempVectorNode + remoteNode := aRemoteTempVectorNode! Item was added: + ----- Method: TempVariableNode>>resetFromCopy: (in category 'code generation') ----- + resetFromCopy: aFieldNode + "Reset the state of the recever to match that of the argument. + This is used to reset nodes that may have been repurposed + while generatig the compiled method for a full block. + Temps are managed via the reindexingLocalsDo:encoder: route, + not via reindexingLiteralsDo:." + self shouldNotImplement! Item was added: + ----- Method: TempVariableNode>>scope (in category 'testing') ----- + scope + "Answer scope of temporary variables. + Currently only the following distinctions are made: + 0 outer level: args and user-declared temps + 1 block args and doLimiT temps + -1 a block temp that is no longer active + -2 a block temp that held limit of to:do:" + ^scope! Item was added: + ----- Method: TempVariableNode>>scope: (in category 'initialize-release') ----- + scope: level + "Note scope of temporary variables. + Currently only the following distinctions are made: + 0 outer level: args and user-declared temps + 1 block args and doLimiT temps + -1 a block temp that is no longer active + -2 a block temp that held limit of to:do:" + scope := level! Item was added: + ----- Method: TempVariableNode>>sizeCodeForStore: (in category 'code generation') ----- + sizeCodeForStore: encoder + remoteNode ~~ nil ifTrue: + [^remoteNode sizeCodeForStoreInto: self encoder: encoder]. + self reserve: encoder. + ^encoder sizeStoreTemp: index! Item was added: + ----- Method: TempVariableNode>>sizeCodeForStorePop: (in category 'code generation') ----- + sizeCodeForStorePop: encoder + remoteNode ~~ nil ifTrue: + [^remoteNode sizeCodeForStorePopInto: self encoder: encoder]. + self reserve: encoder. + ^encoder sizeStorePopTemp: index! Item was added: + ----- Method: TempVariableNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + remoteNode ~~ nil ifTrue: + [^remoteNode sizeCodeForValueOf: self encoder: encoder]. + self reserve: encoder. + ^encoder sizePushTemp: index! Item was added: + ParserNotification subclass: #UndeclaredVariable + instanceVariableNames: 'parser interval' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Exceptions'! Item was added: + ----- Method: UndeclaredVariable class>>signalFor:name:inRange: (in category 'instance creation') ----- + signalFor: aParser name: aString inRange: anInterval + ^ (self new setParser: aParser name: aString range: anInterval) signal! Item was added: + ----- Method: UndeclaredVariable>>openMenuIn: (in category 'handling') ----- + openMenuIn: aBlock + | alternatives labels actions lines caption choice | + alternatives := parser possibleVariablesFor: name. + labels := OrderedCollection new. + actions := OrderedCollection new. + lines := OrderedCollection new. + name first isLowercase + ifTrue: + [labels add: 'declare method temp' translated. + actions add: [parser declareTemp: name at: #method]. + labels add: 'declare block-local temp' translated. + actions add: [parser declareTemp: name at: #block]. + parser canDeclareInstanceVariable + ifTrue: + [labels add: 'declare instance' translated. + actions add: [parser declareInstVar: name]]] + ifFalse: + [labels add: 'define new class' translated. + actions add: [parser defineClass: name]. + labels add: 'declare global' translated. + actions add: [parser declareGlobal: name]. + parser canDeclareClassVariable + ifTrue: + [labels add: 'declare class variable' translated. + actions add: [parser declareClassVar: name]]]. + lines add: labels size. + alternatives do: + [:each | + labels add: each. + actions add: [parser substituteVariable: each atInterval: interval]]. + lines add: labels size. + labels add: 'cancel' translated. + caption := 'Unknown variable: {1}!! please correct, or cancel:' translated format: {name}. + choice := aBlock value: labels value: lines value: caption. + self resume: (actions at: choice ifAbsent: [nil])! Item was added: + ----- Method: UndeclaredVariable>>setParser:name:range: (in category 'initialize-release') ----- + setParser: aParser name: aString range: anInterval + parser := aParser. + name := aString. + interval := anInterval! Item was added: + VariableNode subclass: #UndeclaredVariableNode + instanceVariableNames: 'tag' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! Item was added: + ----- Method: UndeclaredVariableNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitUndeclaredVariableNode: self! Item was added: + ----- Method: UndeclaredVariableNode>>isUndeclared (in category 'testing') ----- + isUndeclared + ^true! Item was added: + ----- Method: UndeclaredVariableNode>>tag (in category 'accessing') ----- + tag + "Tag can be whatever one wants it to be; used by Parser to tag + undeclared temps with the user's desired declaration level." + + ^tag! Item was added: + ----- Method: UndeclaredVariableNode>>tag: (in category 'accessing') ----- + tag: anObject + "Tag can be whatever one wants it to be; used by Parser to tag + undeclared temps with the user's desired declaration level." + + tag := anObject! Item was added: + Notification subclass: #UndeclaredVariableNotification + instanceVariableNames: 'name selector class' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! Item was added: + ----- Method: UndeclaredVariableNotification>>defaultAction (in category 'exceptionDescription') ----- + defaultAction + "The user should be notified of the occurrence of an exceptional occurrence and + given an option of continuing or aborting the computation. The description of the + occurrence should include any text specified as the argument of the #signal: message." + + selector ifNotNil: [Transcript cr; nextPutAll: class name, '>>', selector, ' '] + ifNil: [Transcript cr ]. + Transcript show: '(' , name , ' is Undeclared) '. + ^true! Item was added: + ----- Method: UndeclaredVariableNotification>>defaultResumeValue (in category 'initialize-release') ----- + defaultResumeValue + "Answer the value that by default should be returned if the exception is resumed" + ^true! Item was added: + ----- Method: UndeclaredVariableNotification>>name:selector:class: (in category 'initialize-release') ----- + name: aString selector: aSymbolOrNil class: aBehavior + name := aString. + selector := aSymbolOrNil. + class := aBehavior! Item was added: + ParserNotification subclass: #UndefinedVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Exceptions'! Item was added: + ----- Method: UndefinedVariable>>openMenuIn: (in category 'handling') ----- + openMenuIn: aBlock + + self resume: (Project uiManager + confirm: ('{1} appears to be undefined at this point.\Proceed anyway?' translated withCRs asText + format: {name asText allBold}) + orCancel: [false] + title: 'Undefined Variable' translated).! Item was added: + ParserNotification subclass: #UnknownSelector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Exceptions'! Item was added: + ----- Method: UnknownSelector>>openMenuIn: (in category 'handling') ----- + openMenuIn: aBlock + | alternatives labels lines caption choice | + alternatives := Symbol possibleSelectorsFor: name. + labels := Array streamContents: + [:s | s nextPut: name; nextPutAll: alternatives]. + lines := {1. alternatives size + 1}. + caption := 'Unknown selector, please\confirm, correct, or cancel' translated withCRs. + + choice := aBlock value: labels value: lines value: caption. + + choice = 0 ifTrue: [^ self resume: nil]. + choice = 1 ifTrue: [^ self resume: name asSymbol]. + self resume: (alternatives at: choice - 1)! Item was added: + ParserNotification subclass: #UnusedVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Exceptions'! Item was added: + ----- Method: UnusedVariable>>openMenuIn: (in category 'handling') ----- + openMenuIn: aBlock + + self resume: (Project uiManager + confirm: ('{1} appears to be unused in this method.\Remove it from the code?' translated withCRs asText + format: {name asText allBold}) + orCancel: [nil] + title: 'Unused Variable' translated).! Item was added: + LeafNode subclass: #VariableNode + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-ParseNodes'! + + !VariableNode commentStamp: '<historical>' prior: 0! + I am a parse tree leaf representing a variable. Note that my name and key are different for pool variables: the key is the Object Reference.! Item was added: + ----- Method: VariableNode class>>initialize (in category 'class initialization') ----- + initialize "VariableNode initialize" + | encoder | + encoder := Encoder new. + StdVariables := Dictionary new: 16. + encoder + fillDict: StdVariables + with: VariableNode + mapping: #('self' 'thisContext' 'super' 'nil' 'false' 'true' ) + to: (Array with: LdSelf with: LdThisContext with: LdSuper) + , (Array with: LdNil with: LdFalse with: LdTrue). + StdSelectors := Dictionary new: 64. + encoder + fillDict: StdSelectors + with: SpecialSelectorNode + mapping: ((1 to: Smalltalk specialSelectorSize) collect: + [:i | Smalltalk specialSelectorAt: i]) + to: (1 to: Smalltalk specialSelectorSize) asArray. + StdLiterals := PluggableDictionary new equalBlock: #literalEqual:. "This is at least as fast as a block and eliminates a recompileAll dependency. eem 10/8/2019" + encoder + fillDict: StdLiterals + with: LiteralNode + mapping: #(-1 0 1 2 ) + to: (LdMinus1 to: LdMinus1 + 3). + encoder initScopeAndLiteralTables. + + NodeNil := encoder encodeVariable: 'nil'. + NodeTrue := encoder encodeVariable: 'true'. + NodeFalse := encoder encodeVariable: 'false'. + NodeSelf := encoder encodeVariable: 'self'. + NodeThisContext := encoder encodeVariable: 'thisContext'. + NodeSuper := encoder encodeVariable: 'super'! Item was added: + ----- Method: VariableNode>>accept: (in category 'visiting') ----- + accept: aVisitor + ^aVisitor visitVariableNode: self! Item was added: + ----- Method: VariableNode>>asStorableNode: (in category 'initialize-release') ----- + asStorableNode: encoder + ^ self! Item was added: + ----- Method: VariableNode>>assignmentCheck:at: (in category 'testing') ----- + assignmentCheck: encoder at: location + ^(encoder cantStoreInto: name) ifTrue: [location] ifFalse: [-1]! Item was added: + ----- Method: VariableNode>>beingAssignedToAnalyseTempsWithin:rootNode:assignmentPools: (in category 'closure analysis') ----- + beingAssignedToAnalyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>" + "No-op overridden by TempVariableNode"! Item was added: + ----- Method: VariableNode>>emitCodeForReturn:encoder: (in category 'code generation') ----- + emitCodeForReturn: stack encoder: encoder + encoder + if: code + isSpecialLiteralForReturn: + [:specialLiteral| + "short returns" + encoder genReturnSpecialLiteral: specialLiteral. + stack push: 1 "doesnt seem right". + ^self]. + (self code = LdSelf or: [self code = LdSuper]) ifTrue: + ["short returns" + encoder genReturnReceiver. + stack push: 1 "doesnt seem right". + ^self]. + super emitCodeForReturn: stack encoder: encoder! Item was added: + ----- Method: VariableNode>>emitCodeForStore:encoder: (in category 'code generation') ----- + emitCodeForStore: stack encoder: encoder + + self shouldNotImplement! Item was added: + ----- Method: VariableNode>>emitCodeForStorePop:encoder: (in category 'code generation') ----- + emitCodeForStorePop: stack encoder: encoder + self type ~= 1 ifTrue: + [self halt]. + encoder genStorePopInstVar: index. + stack pop: 1! Item was added: + ----- Method: VariableNode>>emitCodeForValue:encoder: (in category 'code generation') ----- + emitCodeForValue: stack encoder: encoder + stack push: 1. + encoder + if: code + isSpecialLiteralForPush: + [:specialLiteral| + ^encoder genPushSpecialLiteral: specialLiteral]. + (code = LdSelf or: [code = LdSuper]) ifTrue: + [^encoder genPushReceiver]. + code = LdThisContext ifTrue: + [^encoder genPushThisContext]. + self error: 'internal compiler error; should not happen'! Item was added: + ----- Method: VariableNode>>fieldOffset (in category 'code generation') ----- + fieldOffset + "Return temp or instVar offset for this variable" + ^index ifNil: [code < 256 + ifTrue: [code \\ 16] + ifFalse: [code \\ 256]]! Item was added: + ----- Method: VariableNode>>index (in category 'testing') ----- + index + "If index is nil, this code attempts to reconstruct the index from its encoding in code." + index ifNotNil: + [^index]. + code < 0 ifTrue:[^nil]. + code > 256 ifTrue: + [self assert: index = (code \\ 256). + ^code \\ 256]. + code >= (CodeBases at: self type) ifTrue: + [self assert: index = (code - (CodeBases at: self type)). + ^code - (CodeBases at: self type)]. + self assert: index = (code - self type). + ^code - self type! Item was added: + ----- Method: VariableNode>>isSelfPseudoVariable (in category 'testing') ----- + isSelfPseudoVariable + "Answer if this ParseNode represents the 'self' pseudo-variable." + + ^ key = 'self' or: [name = '{{self}}']! Item was added: + ----- Method: VariableNode>>isUndeclared (in category 'testing') ----- + isUndeclared + ^false! Item was added: + ----- Method: VariableNode>>isVariableNode (in category 'testing') ----- + isVariableNode + ^true! Item was added: + ----- Method: VariableNode>>isVariableReference (in category 'testing') ----- + isVariableReference + + ^true! Item was added: + ----- Method: VariableNode>>name (in category 'accessing') ----- + name + ^ name! Item was added: + ----- Method: VariableNode>>name: (in category 'initialize-release') ----- + name: string + "Change name" + + name := string! Item was added: + ----- Method: VariableNode>>name:index:type: (in category 'initialize-release') ----- + name: varName index: i type: type + "Only used for initting instVar refs" + ^self name: varName key: varName index: i type: type! Item was added: + ----- Method: VariableNode>>name:key:code: (in category 'initialize-release') ----- + name: string key: object code: byte + "Only used for initting std variables, nil, true, false, self, etc." + name := string. + key := object. + code := byte! Item was added: + ----- Method: VariableNode>>name:key:index:type: (in category 'initialize-release') ----- + name: varName key: objRef index: i type: type + "Only used for initting global (litInd) variables" + ^self name: varName key: objRef code: (self code: (index := i) type: type)! Item was added: + ----- Method: VariableNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + + aStream nextPutAll: name! Item was added: + ----- Method: VariableNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- + printWithClosureAnalysisOn: aStream indent: level + + aStream nextPutAll: name! Item was added: + ----- Method: VariableNode>>resetFromCopy: (in category 'code generation') ----- + resetFromCopy: aVariableNode + "Reset the state of the recever to match that of the argument. + This is used to reset nodes that may have been repurposed + while generatig the compiled method for a full block." + + self assert: name == aVariableNode name. + super resetFromCopy: aVariableNode! Item was added: + ----- Method: VariableNode>>sizeCodeForReturn: (in category 'code generation') ----- + sizeCodeForReturn: encoder + encoder + if: code + isSpecialLiteralForReturn: + [:specialLiteral| + ^encoder sizeReturnSpecialLiteral: specialLiteral]. + (self code = LdSelf or: [self code = LdSuper]) ifTrue: + [^encoder sizeReturnReceiver]. + ^super sizeCodeForReturn: encoder! Item was added: + ----- Method: VariableNode>>sizeCodeForStore: (in category 'code generation') ----- + sizeCodeForStore: encoder + self shouldNotImplement! Item was added: + ----- Method: VariableNode>>sizeCodeForStorePop: (in category 'code generation') ----- + sizeCodeForStorePop: encoder + self shouldNotImplement! Item was added: + ----- Method: VariableNode>>sizeCodeForValue: (in category 'code generation') ----- + sizeCodeForValue: encoder + self reserve: encoder. + encoder + if: code + isSpecialLiteralForPush: + [:specialLiteral| "i.e. the pseudo-variables nil true & false" + ^encoder sizePushSpecialLiteral: specialLiteral]. + (code = LdSelf or: [code = LdSuper]) ifTrue: + [^encoder sizePushReceiver]. + code = LdThisContext ifTrue: + [^encoder sizePushThisContext]. + self error: 'internal compiler error; should not happen'! Item was added: + ----- Method: VariableNode>>type (in category 'testing') ----- + type + "This code attempts to reconstruct the type from its encoding in code. + This allows one to test, for instance, (aNode type = LdInstType)." + | type | + code < 0 ifTrue: [^code negated]. + code >= 256 ifTrue: [^code // 256]. + type := CodeBases findFirst: [:one | code < one]. + ^type = 0 ifTrue: [5] ifFalse: [type - 1]! Item was added: + ParseNodeVisitor subclass: #VariableScopeFinder + instanceVariableNames: 'theVariable' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler-Support'! + + !VariableScopeFinder commentStamp: 'eem 8/14/2010 19:45' prior: 0! + A VariableScopeFinder is used to find the minimum enclosing scope of a variable in a method. This is used when auto-declaring temporaries to find the smallest enclosing block in which to declare the temp. + + Instance Variables + theVariable: <VariableNode> + + theVariable + - the varable whose scope is to be determined + ! Item was added: + ----- Method: VariableScopeFinder>>enclosingNodeFor:of: (in category 'private') ----- + enclosingNodeFor: enumerator of: rootNode + "Answer the minimum enclosing root node for aVariabe or nil if none. + If the variable is accessed in more than one subnode then the rootNode is the + enclosing node, otherwise it is which ever single subnode node that includes it, if any. + enumerator applies its argument to all relevant subnodes of rootNode." + | enclosingNodeOrNil | + enclosingNodeOrNil := nil. + enumerator value: + [:subnode| + (subnode accept: self) ifNotNil: + [:enclosingNode| + enclosingNodeOrNil := enclosingNodeOrNil + ifNil: [enclosingNode] + ifNotNil: [rootNode]]]. + ^enclosingNodeOrNil! Item was added: + ----- Method: VariableScopeFinder>>ofVariable: (in category 'initialize-release') ----- + ofVariable: aVariableNode + theVariable := aVariableNode! Item was added: + ----- Method: VariableScopeFinder>>visitAssignmentNode: (in category 'visiting') ----- + visitAssignmentNode: anAssignmentNode + "Answer the minimum enclosing node for aVariabe or nil if none. + If the variable is accessed in more than one subexpression then anAssignmentNode + is the enclosing node, otherwise it is which ever single node that includes it, if any." + ^self + enclosingNodeFor: [:aBlock| + aBlock + value: anAssignmentNode value; + value: anAssignmentNode variable] + of: anAssignmentNode! Item was added: + ----- Method: VariableScopeFinder>>visitBlockNode: (in category 'visiting') ----- + visitBlockNode: aBlockNode + "Answer the minimum enclosing node for aVariabe or nil if none. + If the variable is accessed in more than one statement then aBlockNode is the + enclosing node, otherwise it is which ever single block node that includes it, if any." + ^(self enclosingNodeFor: [:aBlock| aBlockNode statements do: aBlock] of: aBlockNode) ifNotNil: + [:aNode| + aNode isBlockNode ifTrue: [aNode] ifFalse: [aBlockNode]]! Item was added: + ----- Method: VariableScopeFinder>>visitBraceNode: (in category 'visiting') ----- + visitBraceNode: aBraceNode + "Answer the minimum enclosing node for aVariabe or nil if none. + If the variable is accessed in more than one subexpression then aBraceNode + is the enclosing node, otherwise it is which ever single node that includes it, if any." + ^self + enclosingNodeFor: [:aBlock| aBraceNode elements do: aBlock] + of: aBraceNode! Item was added: + ----- Method: VariableScopeFinder>>visitCascadeNode: (in category 'visiting') ----- + visitCascadeNode: aCascadeNode + "Answer the minimum enclosing node for aVariabe or nil if none. + If the variable is accessed in more than one subexpression then aMessageNode is the + enclosing node, otherwise it is which ever single node that includes it, if any." + ^self + enclosingNodeFor: [:aBlock| + aBlock value: aCascadeNode receiver. + aCascadeNode messages do: + [:msg| msg argumentsInEvaluationOrder do: aBlock]] + of: aCascadeNode! Item was added: + ----- Method: VariableScopeFinder>>visitCommentNode: (in category 'visiting') ----- + visitCommentNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitFieldNode: (in category 'visiting') ----- + visitFieldNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitFutureNode: (in category 'visiting') ----- + visitFutureNode: aFutureNode + ^aFutureNode receiver accept: self! Item was added: + ----- Method: VariableScopeFinder>>visitInstanceVariableNode: (in category 'visiting') ----- + visitInstanceVariableNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitLiteralNode: (in category 'visiting') ----- + visitLiteralNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitLiteralVariableNode: (in category 'visiting') ----- + visitLiteralVariableNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitMessageNode: (in category 'visiting') ----- + visitMessageNode: aMessageNode + "Answer the minimum enclosing node for aVariabe or nil if none. + If the variable is accessed in more than one subexpression then aMessageNode is the + enclosing node, otherwise it is which ever single node that includes it, if any." + ^self + enclosingNodeFor: [:aBlock| + aBlock value: aMessageNode receiver. + aMessageNode argumentsInEvaluationOrder do: aBlock] + of: aMessageNode! Item was added: + ----- Method: VariableScopeFinder>>visitMethodNode: (in category 'visiting') ----- + visitMethodNode: aMethodNode + ^aMethodNode block accept: self! Item was added: + ----- Method: VariableScopeFinder>>visitNewArrayNode: (in category 'visiting') ----- + visitNewArrayNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitRemoteTempVectorNode: (in category 'visiting') ----- + visitRemoteTempVectorNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitReturnNode: (in category 'visiting') ----- + visitReturnNode: aReturnNode + ^aReturnNode expr accept: self! Item was added: + ----- Method: VariableScopeFinder>>visitSelectorNode: (in category 'visiting') ----- + visitSelectorNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitTempVariableNode: (in category 'visiting') ----- + visitTempVariableNode: aNode + ^nil! Item was added: + ----- Method: VariableScopeFinder>>visitUndeclaredVariableNode: (in category 'visiting') ----- + visitUndeclaredVariableNode: aVariableNode + ^theVariable name = aVariableNode name ifTrue: [theVariable]! Item was added: + ----- Method: VariableScopeFinder>>visitVariableNode: (in category 'visiting') ----- + visitVariableNode: aVariableNode + ^nil! Item was added: + (PackageInfo named: 'Compiler') postscript: '"below, add code to be run after the loading of this package" + + "Recompile senders of caseOf:" + self systemNavigation allSelectorsAndMethodsDo: [ :behavior :selector :method | + (method hasLiteral: #caseOf:) + ifTrue: [behavior recompile: selector]]. + + "Treat non-breaking space (16ra0) as delimiter in parser/scanner (Compiler-ct.473)." + Scanner initialize.'!

5 5

The Trunk: System-tonyg.1224.mcz
by commits＠source.squeak.org 14 Sep '22

14 Sep '22

Tony Garnock-Jones uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tonyg.1224.mcz ==================== Summary ==================== Name: System-tonyg.1224 Author: tonyg Time: 29 March 2021, 10:15:02.279821 am UUID: 9d897d72-46fc-4205-a27b-89c7a50ac104 Ancestors: System-mt.1223 Teach SystemOrganizer about multiple environments. =============== Diff against System-mt.1223 =============== Item was changed: Categorizer subclass: #SystemOrganizer + instanceVariableNames: 'environment' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !SystemOrganizer commentStamp: '<historical>' prior: 0! My instances provide an organization for the classes in the system, just as a ClassOrganizer organizes the messages within a class. The only difference is the methods for fileIn/Out.! Item was changed: ----- Method: SystemOrganizer>>classesIn: (in category 'query') ----- classesIn: categoryName | classes | classes := OrderedCollection new. self categories withIndexCollect: [:cat :idx | (categoryName match: cat) ifTrue: [classes addAll: (self listAtCategoryNumber: idx)] ifFalse: [nil]]. + ^ classes collect: [:clsName | self environment classNamed: clsName]! - ^ classes collect: [:clsName | Smalltalk classNamed: clsName]! Item was changed: ----- Method: SystemOrganizer>>classify:under: (in category 'accessing') ----- classify: element under: newCategory | oldCategory class | self flag: #environments. "do we want notifications for classes in other environments?" oldCategory := self categoryOfElement: element. super classify: element under: newCategory. + class := self environment at: element ifAbsent: [^ self]. - class := Smalltalk at: element ifAbsent: [^ self]. self == SystemOrganization ifTrue: [ SystemChangeNotifier uniqueInstance class: class recategorizedFrom: oldCategory to: newCategory]! Item was changed: ----- Method: SystemOrganizer>>commentInventory: (in category 'query') ----- commentInventory: categoryName "SystemOrganization commentInventory: 'Morphic*'" | classes commentedClasses | classes := OrderedCollection new. self categories withIndexCollect: [:cat :idx | (categoryName match: cat) ifTrue: [classes addAll: (self listAtCategoryNumber: idx)] ifFalse: [nil]]. + commentedClasses := classes select: [:catCls | (self environment at: catCls) hasComment]. - commentedClasses := classes select: [:catCls | (Smalltalk at: catCls) hasComment]. ^ 'There are ' , classes size asString , ' classes in ' , categoryName , ' of which ' , commentedClasses size asString , ' have comments and ', (classes size - commentedClasses size) asString , ' do not yet have comments.' ! Item was added: + ----- Method: SystemOrganizer>>environment (in category 'accessing') ----- + environment + ^ environment ifNil: [Smalltalk globals]! Item was added: + ----- Method: SystemOrganizer>>environment: (in category 'accessing') ----- + environment: anEnvironment + environment := anEnvironment! Item was changed: ----- Method: SystemOrganizer>>fileOutCategory:on:initializing: (in category 'fileIn/Out') ----- fileOutCategory: category on: aFileStream initializing: aBool "Store on the file associated with aFileStream, all the traits and classes associated with the category and any requested shared pools in the right order." | first poolSet tempClass classes traits | traits := self orderedTraitsIn: category. classes := self superclassOrder: category. poolSet := Set new. classes do: [:class | class sharedPools do: [:eachPool | poolSet add: eachPool]]. poolSet size > 0 ifTrue: [ tempClass := Class new. tempClass shouldFileOutPools ifTrue: [ poolSet := poolSet select: [:aPool | + tempClass shouldFileOutPool: (self environment keyAtIdentityValue: aPool)]. - tempClass shouldFileOutPool: (Smalltalk globals keyAtIdentityValue: aPool)]. poolSet do: [:aPool | tempClass fileOutPool: aPool onFileStream: aFileStream]]]. first := true. traits, classes do: [:each | first ifTrue: [first := false] ifFalse: [aFileStream cr; nextPut: Character newPage; cr]. each fileOutOn: aFileStream moveSource: false toFile: 0 initializing: false]. aBool ifTrue: [classes do: [:cls | cls fileOutInitializerOn: aFileStream]].! Item was changed: ----- Method: SystemOrganizer>>orderedTraitsIn: (in category 'fileIn/Out') ----- orderedTraitsIn: category "Answer an OrderedCollection containing references to the traits in the category whose name is the argument, category (a string). The traits are ordered so they can be filed in." | behaviors traits | behaviors := (self listAtCategoryNamed: category asSymbol) + collect: [:title | self environment at: title]. - collect: [:title | Smalltalk at: title]. traits := behaviors reject: [:each | each isBehavior]. ^traits asArray sort: [:t1 :t2 | (t2 traitComposition allTraits includes: t1) or: [(t1 traitComposition allTraits includes: t2) not]]! Item was changed: ----- Method: SystemOrganizer>>removeMissingClasses (in category 'remove') ----- removeMissingClasses "Remove any class names that are no longer in the Smalltalk dictionary. Used for cleaning up after garbage collecting user-generated classes." "SystemOrganization removeMissingClasses" elementArray copy do: [:el | + (self environment includesKey: el) ifFalse: [self removeElement: el]]. - (Smalltalk includesKey: el) ifFalse: [self removeElement: el]]. ! Item was changed: ----- Method: SystemOrganizer>>superclassOrder: (in category 'fileIn/Out') ----- superclassOrder: category "Answer an OrderedCollection containing references to the classes in the category whose name is the argument, category (a string). The classes are ordered with superclasses first so they can be filed in." | behaviors classes | behaviors := (self listAtCategoryNamed: category asSymbol) + collect: [:title | self environment at: title]. - collect: [:title | Smalltalk at: title]. classes := behaviors select: [:each | each isBehavior]. ^ChangeSet superclassOrder: classes!

5 7

Question on Magma.
by Edwin Ancaer 14 Sep '22

14 Sep '22

Hello, Should I be able to install Magma in Squeak 5.3? *Image-----* /usr/home/edwin/Smalltalk53/magma.image Squeak5.3 latest update: #19481 Current Change Set: HomeProject Image format 68021 (64 bit) *Virtual Machine---------------* /usr/home/edwin/Smalltalk53/opensmalltalk-vm/building/linux64x64/squeak.cog.spur/build/squeak Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3142] Unix built on Aug 15 2022 13:47:05 Compiler: FreeBSD Clang 10.0.1 (git@github.com:llvm/llvm-project.git llvmorg-10.0.1-0-gef32c611aa2) platform sources revision VM: 202201220125 edwin@ottopedi:/usr/home/edwin/Smalltalk53/opensmalltalk-vm Date: Fri Jan 21 17:25:16 2022 CommitHash: 0df6348be Plugins: 202201220125 edwin@ottopedi:/usr/home/edwin/Smalltalk53/opensmalltalk-vm I used SqueaKmap to install VERSION 1.65 tests of Magma and then, following https://wiki.squeak.org/squeak/2689, executed MagmaRepositoryController create: '/home/edwin/MyMagmaFolder' root: PDAPerson new. and got the message: MessageNotUnderstood: SmallInteger>>isByteString, as in the added screenshot. Can this be my image/VM that cause this problem? Kind regards, Edwin Ancaer

3 5

The Trunk: Morphic-ct.2043.mcz
by commits＠source.squeak.org 13 Sep '22

13 Sep '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.2043.mcz ==================== Summary ==================== Name: Morphic-ct.2043 Author: ct Time: 13 September 2022, 7:54:00.818738 pm UUID: e022b4f2-ce6b-584a-b084-1ce60b8cefeb Ancestors: Morphic-ct.2042 Fixes yellow-button menu invocation for pluggable lists that are not inside a system window. For instance, pluggable lists with in a dialog could not bring up their own menu previously but their containing dialog window's yellow-button menu was shown instead. See also Morphic-ct.1789. =============== Diff against Morphic-ct.2042 =============== Item was changed: ----- Method: PluggableListMorph>>createListMorph (in category 'initialization') ----- createListMorph ^ self listMorphClass new listSource: self; cellInset: self class listMargins; hResizing: #spaceFill; vResizing: #shrinkWrap; cellPositioning: #leftCenter; setProperty: #indicateKeyboardFocus toValue: #never; + wantsYellowButtonMenu: false; yourself.! Item was changed: ----- Method: PluggableListMorph>>initialize (in category 'initialization') ----- initialize listMorph := self createListMorph. super initialize. self scroller layoutPolicy: TableLayout new; + wantsYellowButtonMenu: false; + addMorph: listMorph. - addMorph: listMorph. self minimumWidth: (self font widthOf: $m) * 5 ; minimumHeight: self font height !

2 1

ResumableTestFailure
by Thiede, Christoph 13 Sep '22

13 Sep '22

Hi all! :-) I was just working a bit with Squeak by Example (the book) and found out that resumable assertions as described in the book (see chapter SUnit, Advanced, Continuing after a failure) do not any longer work in a trunk image. If you write a test case with some resumable assertions, turn on logging, and run the test, only the first failure will be logged, not the rest, too. (Methods to reproduce: isLogging ^ true "You will need to open a Transcript" testResumable #(1 2 3 4 5) do: [:i | self assert: i even description: ['{1} is not even' format: {i}] resumable: true] ) A second issue I experienced frequently when I felt the desire to work with resumable assertions was that they are basically only available for two selectors: #assert:description:resumable: and #deny:description:identical:. I often would like to insert a resumable into any test without being that verbose, and nearly redoubling the number of assertion selectors by adding a resumable argument to each of them did not feel right, either. Please find the attached changeset, which fixes both issues. * In TestResult >> #runCase:, resumable assertions are identified and - finally - resumed, after marking the test as failed. Unfortunately, other test runners (yes, I'm thinking of smalltalkCI) will need to reimplement this feature unless they reuse the TestResult implementation. * In TestCase, I refactored some methods that raise assertion failures and added the most basic #signalFailure:resumable: as the single source of signalization. Instead of setting the resumable bit manually for each assertion, you now can also make the whole test execution resumable by: * overriding #isResumable, * setting a resumable flag using #resumable:, * setting a resumable flag temporarily using #beResumable:during:, or * adding a <resumable> or <resumable: true> pragma to the test method. * In addition, I tested the added and fixed behavior in ResumableTestFailureTestCase. Looking forward to your review! :-) Best, Christoph

2 2

The Trunk: Files-eem.195.mcz
by commits＠source.squeak.org 13 Sep '22

13 Sep '22

Eliot Miranda uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-eem.195.mcz ==================== Summary ==================== Name: Files-eem.195 Author: eem Time: 13 July 2022, 9:09:36.427827 pm UUID: 7ccbfb5c-e5d3-4911-9497-09fdc484d09c Ancestors: Files-eem.194 Occasionally FileDirectory>>exists fails. The old implementation seems unreliable, but it's also slow. So if possible, implement it above primLookupEntryIn:name: Old: | foo bar baz | foo := FileDirectory on: '/no/where/at/all'. bar := FileDirectory on: '/Users/eliot/Desktop/not there'. baz := FileDirectory default. [foo exists. bar exists. baz exists] bench '8,070 per second. 124 microseconds per run. 0 % GC time.' New: | foo bar baz | foo := FileDirectory on: '/no/where/at/all'. bar := FileDirectory on: '/Users/eliot/Desktop/not there'. baz := FileDirectory default. [foo exists. bar exists. baz exists] bench '73,700 per second. 13.6 microseconds per run. 0.64 % GC time.' =============== Diff against Files-eem.194 =============== Item was changed: ----- Method: FileDirectory>>exists (in category 'testing') ----- exists + "Answer whether the directory exists" + ^self class currentDirectoryNickname + ifNotNil: + [:me| + (self primLookupEntryIn: pathName asVmPathName name: me asVmPathName) + ifNil: [false] + ifNotNil: [:maybeErr| maybeErr ~~ #primFailed]] + ifNil: + [(self primLookupEntryIn: pathName asVmPathName index: 1) ~~ #badDirectoryPath]! - "Answer whether the directory exists" - - | result | - result := self primLookupEntryIn: pathName asVmPathName index: 1. - ^ result ~= #badDirectoryPath - !

7 9

The Inbox: Files-ct.198.mcz
by commits＠source.squeak.org 13 Sep '22

13 Sep '22

Christoph Thiede uploaded a new version of Files to project The Inbox: http://source.squeak.org/inbox/Files-ct.198.mcz ==================== Summary ==================== Name: Files-ct.198 Author: ct Time: 13 September 2022, 2:09:02.615711 pm UUID: 022ceb10-85c8-fa42-8461-2a09bbacd572 Ancestors: Files-ct.197 Fixes FileDirectory>>#exists for files again, which must answer true for and only for directories. These "false negatives" led to spurious errors (MessageNotUnderstood: DosFileDirectory>>readOnlyStream) on Windows in the recent past when dragging a host system file into the image (see FileDirectory class>>#dropFilesAndDirectories:). This seems to be a regression from Files-eem.195. Note that when given a non-directory path, primitiveDirectoryEntry fails on Linux but answers a valid tuple on Windows. =============== Diff against Files-ct.197 =============== Item was changed: ----- Method: FileDirectory>>exists (in category 'testing') ----- exists "Answer whether the directory exists" ^self class currentDirectoryNickname ifNotNil: [:me| (self primLookupEntryIn: pathName asVmPathName name: me asVmPathName) ifNil: [false] + ifNotNil: [:entryArray | entryArray ~~ #primFailed + and: [(entryArray at: 4) "dirFlag"]]] - ifNotNil: [:maybeErr| maybeErr ~~ #primFailed]] ifNil: [(self primLookupEntryIn: pathName asVmPathName index: 1) ~~ #badDirectoryPath]!

1 0

The Trunk: Morphic-ct.2042.mcz
by commits＠source.squeak.org 13 Sep '22

13 Sep '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.2042.mcz ==================== Summary ==================== Name: Morphic-ct.2042 Author: ct Time: 13 September 2022, 12:56:21.695245 pm UUID: a7bc1e43-0ab0-ae4a-86e0-a5b567be9252 Ancestors: Morphic-ct.2041 Improves high-dpi support for sliders. Scroll bars were already high-dpi-sensitive and are not affected by this change. =============== Diff against Morphic-ct.2041 =============== Item was changed: ----- Method: Slider>>defaultBounds (in category 'initialization') ----- defaultBounds "answer the default bounds for the receiver" + ^ 0 @ 0 corner: 16 px @ 100 px! - ^ 0 @ 0 corner: 16 @ 100! Item was changed: ----- Method: Slider>>sliderThickness (in category 'geometry') ----- sliderThickness + ^ 7 px! - ^ 7!

1 0

The Trunk: MorphicExtras-ct.334.mcz
by commits＠source.squeak.org 13 Sep '22

13 Sep '22

Christoph Thiede uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ct.334.mcz ==================== Summary ==================== Name: MorphicExtras-ct.334 Author: ct Time: 13 September 2022, 12:48:55.351245 pm UUID: f0833010-8910-ed49-b92e-9ff467ecd684 Ancestors: MorphicExtras-ct.333 Improves high-dpi support for DropDownChoiceMorph (sharp sub menu marker). =============== Diff against MorphicExtras-ct.333 =============== Item was added: + ----- Method: DropDownChoiceMorph class>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + self initializeSubMenuMarker.! Item was changed: ----- Method: DropDownChoiceMorph class>>initialize (in category 'class initialization') ----- initialize "DropDownChoiceMorph initialize" + self initializeSubMenuMarker.! - | f | - f := Form - extent: 5@9 - fromArray: #(2147483648 3221225472 3758096384 4026531840 4160749568 4026531840 3758096384 3221225472 2147483648) - offset: 0@0. - SubMenuMarker := ColorForm mappingWhiteToTransparentFrom: f. - ! Item was added: + ----- Method: DropDownChoiceMorph class>>initializeSubMenuMarker (in category 'class initialization') ----- + initializeSubMenuMarker + + | form | + form := Form extent: 5 px @ 9 px depth: 1. + form getCanvas + drawPolygon: {0 @ 0. 0 @ form height. form width @ (form height // 2)} + fillStyle: Color black. + SubMenuMarker := ColorForm mappingWhiteToTransparentFrom: form.! Item was added: + ----- Method: DropDownChoiceMorph class>>themeProperties (in category 'updating') ----- + themeProperties + "Ensure that #applyUserInterfaceTheme is sent." + + ^ super themeProperties + , {{#placeholder. '<placeholder>'. 'Just a placeholder to ensure that this class is sent #applyUserInterfaceTheme updates.'}}!

1 0

The Trunk: MorphicTests-ct.89.mcz
by commits＠source.squeak.org 13 Sep '22

13 Sep '22

Christoph Thiede uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-ct.89.mcz ==================== Summary ==================== Name: MorphicTests-ct.89 Author: ct Time: 13 September 2022, 12:22:09.913695 pm UUID: bf6eefe7-f24d-cf4a-b1a7-7167a703eb23 Ancestors: MorphicTests-ct.88 Adds a regression test for shrinking TransformationMorphs. Complements Morphic-ct.2041. =============== Diff against MorphicTests-ct.88 =============== Item was added: + TestCase subclass: #TransformMorphBugs + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'MorphicTests-Basic'! Item was added: + ----- Method: TransformMorphBugs>>testLayoutConvergence (in category 'tests - geometry') ----- + testLayoutConvergence + + | scale f inner newScale outer | + scale := 0.4. + inner := Morph new color: Color red. + f := inner addFlexShell + scale: scale; + yourself. + + outer := Morph new color: Color yellow. + outer changeTableLayout. + outer addMorph: f. + outer addMorph: (Morph new extent: 30 @ 10). + + 100 timesRepeat: [ + f layoutChanged. outer fullBounds. + newScale := f scale. + self assert: (scale - newScale) abs < 0.001].!

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
16
Older →

Jump to page: