Vm-dev April 2013

vm-dev@lists.squeakfoundation.org

36 participants
107 discussions

CogMT missing some plugins?
by Frank Shearar 18 Apr '13

18 Apr '13

I just noticed that in r.2714 that the Linux CogMT doesn't have some plugins that Cog does: /home/frank/Documents/squeak-ci/target/cog.r2714/coglinux/lib/squeak/4.0-2714: B3DAcceleratorPlugin BochsIA32Plugin LocalePlugin squeak SqueakFFIPrims SqueakSSL UnixOSProcessPlugin UUIDPlugin vm-display-fbdev vm-display-null vm-display-X11 vm-sound-ALSA vm-sound-null vm-sound-OSS versus: /home/frank/Documents/squeak-ci/target/cogmt.r2714/cogmtlinux/lib/squeak/4.0-2705: B3DAcceleratorPlugin BochsIA32Plugin Is that to be expected? frank

1 0

VM Maker: VMMaker-oscog-EstebanLorenzano.237.mcz
by commits＠source.squeak.org 16 Apr '13

16 Apr '13

Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-oscog-EstebanLorenzano.237.mcz ==================== Summary ==================== Name: VMMaker-oscog-EstebanLorenzano.237 Author: EstebanLorenzano Time: 16 April 2013, 4:36:02.907 pm UUID: bfc18b7f-3847-432f-a19c-6988d5f6e2e7 Ancestors: VMMaker-oscog-EstebanLorenzano.236, VMMaker.oscog-eem.285 - merged with Eliot's 285 =============== Diff against VMMaker-oscog-EstebanLorenzano.236 =============== Item was changed: + SmartSyntaxInterpreterPlugin subclass: #BitBltSimulation - InterpreterPlugin subclass: #BitBltSimulation instanceVariableNames: 'destForm sourceForm halftoneForm combinationRule destX destY width height sourceX sourceY clipX clipY clipWidth clipHeight sourceWidth sourceHeight sourceDepth sourcePitch sourceBits sourcePPW sourceMSB destWidth destHeight destDepth destPitch destBits destPPW destMSB bitCount skew mask1 mask2 preload nWords destMask hDir vDir sourceIndex sourceDelta destIndex destDelta sx sy dx dy bbW bbH halftoneHeight noSource noHalftone halftoneBase sourceAlpha srcBitShift dstBitShift bitBltOop affectedL affectedR affectedT affectedB opTable maskTable ditherMatrix4x4 ditherThresholds16 ditherValues16 hasSurfaceLock warpSrcShift warpSrcMask warpAlignShift warpAlignMask warpBitShiftTable querySurfaceFn lockSurfaceFn unlockSurfaceFn isWarping cmFlags cmMask cmShiftTable cmMaskTable cmLookupTable cmBitsPerColor dither8Lookup componentAlphaModeColor componentAlphaModeAlpha ungammaLookupTable gammaLookupTable' classVariableNames: 'AllOnes AlphaIndex BBClipHeightIndex BBClipWidthIndex BBClipXIndex BBClipYIndex BBColorMapIndex BBDestFormIndex BBDestXIndex BBDestYIndex BBHalftoneFormIndex BBHeightIndex BBLastIndex BBRuleIndex BBSourceFormIndex BBSourceXIndex BBSourceYIndex BBWarpBase BBWidthIndex BBXTableIndex BinaryPoint BlueIndex ColorMapFixedPart ColorMapIndexedPart ColorMapNewStyle ColorMapPresent CrossedX EndOfRun FixedPt1 FormBitsIndex FormDepthIndex FormHeightIndex FormWidthIndex GreenIndex JitBltHookSize OpTable OpTableSize RedIndex' poolDictionaries: '' category: 'VMMaker-Interpreter'! + !BitBltSimulation commentStamp: 'tpr 3/25/2013 16:50' prior: 0! - !BitBltSimulation commentStamp: '<historical>' prior: 0! This class implements BitBlt, much as specified in the Blue Book spec. Performance has been enhanced through the use of pointer variables such as sourceIndex and destIndex, and by separating several special cases of the inner loop. Operation has been extended to color, with support for 1, 2, 4, 8, 16, and 32-bit pixel sizes. Conversion between different pixel sizes is facilitated by accepting an optional color map. In addition to the original 16 combination rules, this BitBlt supports 16 fail (for old paint mode) 17 fail (for old mask mode) 18 sourceWord + destinationWord 19 sourceWord - destinationWord 20 rgbAdd: sourceWord with: destinationWord 21 rgbSub: sourceWord with: destinationWord 22 OLDrgbDiff: sourceWord with: destinationWord 23 OLDtallyIntoMap: destinationWord -- old vers doesn't clip to bit boundary 24 alphaBlend: sourceWord with: destinationWord 25 pixPaint: sourceWord with: destinationWord 26 pixMask: sourceWord with: destinationWord 27 rgbMax: sourceWord with: destinationWord 28 rgbMin: sourceWord with: destinationWord 29 rgbMin: sourceWord bitInvert32 with: destinationWord 30 alphaBlendConst: sourceWord with: destinationWord -- alpha passed as an arg 31 alphaPaintConst: sourceWord with: destinationWord -- alpha passed as an arg 32 rgbDiff: sourceWord with: destinationWord 33 tallyIntoMap: destinationWord 34 alphaBlendScaled: sourceWord with: destinationWord + 35 alphaBlendScaled: sourceWord with: "unused here - only used by FXBlt" + 36 alphaBlendScaled: sourceWord with: "unused here - only used by FXBlt" + 37 rgbMul: sourceWord with: destinationWord + 38 pixSwap: sourceWord with: destinationWord + 39 pixClear: sourceWord with: destinationWord + 40 fixAlpha: sourceWord with: destinationWord + 41 rgbComponentAlpha: sourceWord with: destinationWord This implementation has also been fitted with an experimental "warp drive" that allows abritrary scaling and rotation (and even limited affine deformations) with all BitBlt storage modes supported. To add a new rule to BitBlt... 1. add the new rule method or methods in the category 'combination rules' of BBSim 2. describe it in the class comment of BBSim and in the class comment for BitBlt 3. add refs to initializeRuleTable in proper positions 4. add refs to initBBOpTable, following the pattern ! Item was added: + ----- Method: BitBltSimulation>>primitivePixelValueAtX:y: (in category 'primitives') ----- + primitivePixelValueAtX: xVal y: yVal + "returns the single pixel at x@y. + It does not handle LSB bitmaps right now. + If x or y are < 0, return 0 to indicate transparent (cf BitBlt>bitPeekerFromForm: usage). + Likewise if x>width or y>depth. + Fail if the rcvr doesn't seem to be a Form, or x|y seem wrong" + | rcvr bitmap depth ppW stride word mask shift pixel | + rcvr := self primitive: 'primitivePixelValueAt' parameters: #(SmallInteger SmallInteger) receiver: #Oop. + + "possible quick exit if x or y is -ve" + (xVal < 0 or: [ yVal < 0 ] ) ifTrue:[^interpreterProxy integerObjectOf: 0]. + "check that rcvr is plausibly a Form or subclass" + rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount. + ((interpreterProxy isPointers: rcvr) and: [(interpreterProxy slotSizeOf: rcvr) >= 4]) + ifFalse: [^interpreterProxy primitiveFail]. + + "get the bits oop and width/height/depth" + bitmap := interpreterProxy fetchPointer: FormBitsIndex ofObject: rcvr. + width := interpreterProxy fetchInteger: FormWidthIndex ofObject: rcvr. + height := interpreterProxy fetchInteger: FormHeightIndex ofObject: rcvr. + depth := interpreterProxy fetchInteger: FormDepthIndex ofObject: rcvr. + "if width/height/depth are not integer, fail" + interpreterProxy failed ifTrue:[^nil]. + + "possible quick exit if x or y is >= extent of form. This also catches cases where the width/height are < 0" + (xVal >= width or: [ yVal >= height ] ) ifTrue:[^interpreterProxy integerObjectOf: 0]. + + "we don't handle LSB Forms yet" + depth < 0 ifTrue:[^interpreterProxy primitiveFail]. + + "OK so now we know we have a plausible Form, the width/height/depth/x/y are all reasonable and it's time to plunder the bitmap" + ppW := 32//depth. "pixels in each word" + stride := (width + (ppW -1)) // ppW. "how many words per rox of pixels" + word := interpreterProxy fetchLong32:(yVal * stride) + (xVal//ppW) ofObject: bitmap. "load the word that contains our target" + mask := 16rFFFFFFFF >> (32 - depth). "make a mask to isolate the pixel within that word" + shift := 32 - (((xVal bitAnd: ppW-1) + 1) * depth). "this is the tricky MSB part - we mask the xVal to find how far into the word we need, then add 1 for the pixel we're looking for, then * depth to get the bit shift" + pixel := (word >> shift) bitAnd: mask. "shift, mask and dim the lights" + ^ pixel asPositiveIntegerObj "pop the incoming and push our answer" + ! Item was changed: ----- Method: CCodeGenerator>>generateToByDo:on:indent: (in category 'C translation') ----- generateToByDo: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + "N.B. MessageNode>>asTranslatorNodeIn: adds the limit var as a hidden fourth argument." + | blockExpr iterationVar limitExpr mayHaveSideEffects limitVar step negative | + blockExpr := msgNode args third. + blockExpr args size = 1 ifFalse: + [self error: 'wrong number of block arguments']. + iterationVar := blockExpr args first. + limitExpr := msgNode args first. - - | iterationVar step negative | - (msgNode args last args size = 1) ifFalse: [ - self error: 'wrong number of block arguments'. - ]. - iterationVar := msgNode args last args first. aStream nextPutAll: 'for (', iterationVar, ' = '. self emitCExpression: msgNode receiver on: aStream. + mayHaveSideEffects := msgNode args size = 4. "See TMethod>>prepareMethodIn:" + mayHaveSideEffects ifTrue: + [limitVar := msgNode args last. + aStream nextPutAll: ', ', limitVar name, ' = '. + self emitCExpression: limitExpr on: aStream. + limitExpr := limitVar]. aStream nextPutAll: '; ', iterationVar. negative := ((step := msgNode args at: 2) isConstant and: [step value < 0]) or: [step isSend and: [step selector == #negated and: [step receiver isConstant and: [step receiver value >= 0]]]]. aStream nextPutAll: (negative ifTrue: [' >= '] ifFalse: [' <= ']). + self emitCExpression: limitExpr on: aStream. - self emitCExpression: msgNode args first on: aStream. aStream nextPutAll: '; ', iterationVar, ' += '. self emitCExpression: step on: aStream. aStream nextPutAll: ') {'; cr. + blockExpr emitCCodeOn: aStream level: level + 1 generator: self. + aStream tab: level. + aStream nextPut: $}! - msgNode args last emitCCodeOn: aStream level: level + 1 generator: self. - level timesRepeat: [ aStream tab ]. - aStream nextPutAll: '}'.! Item was changed: ----- Method: CCodeGenerator>>removeMethodForSelector: (in category 'utilities') ----- removeMethodForSelector: aSelector "Remove the given method from the code base" + (breakSrcInlineSelector == aSelector + or: [breakDestInlineSelector == aSelector]) ifTrue: + [self halt]. methods removeKey: aSelector ifAbsent: []! Item was changed: StackInterpreterPrimitives subclass: #CoInterpreter instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod lastBackwardJumpMethod backwardJumpCount reenterInterpreter deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod processHasThreadId flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile noThreadingOfGUIThread' + classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield CogitClass HasBeenReturnedFromMCPC MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn' - classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield CogitClass HasBeenReturnedFromMCPC MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn' poolDictionaries: 'CogMethodConstants VMStackFrameOffsets' category: 'VMMaker-JIT'! !CoInterpreter commentStamp: '<historical>' prior: 0! I am a variant of the StackInterpreter that can co-exist with the Cog JIT. I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT. See CogMethod class's comment for method interoperability.! Item was changed: ----- Method: CoInterpreter class>>initializeFrameIndices (in category 'initialization') ----- initializeFrameIndices "Format of a stack frame. Word-sized indices relative to the frame pointer. Terminology Frames are either single (have no context) or married (have a context). Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited). Stacks grow down: receiver for method activations/closure for block activations arg0 ... argN caller's saved ip/this stackPage (for a base frame) fp-> saved fp method context (initialized to nil) frame flags (interpreter only) saved method ip (initialized to 0; interpreter only) receiver first temp ... sp-> Nth temp In an interpreter frame frame flags holds the number of arguments (since argument temporaries are above the frame) the flag for a block activation and the flag indicating if the context field is valid (whether the frame is married). saved method ip holds the saved method ip when the callee frame is a machine code frame. This is because the saved method ip is actually the ceReturnToInterpreterTrampoline address. In a machine code frame the flag indicating if the context is valid is the least significant bit of the method pointer the flag for a block activation is the next most significant bit of the method pointer Interpreter frames are distinguished from method frames by the method field which will be a pointer into the heap for an interpreter frame and a pointer into the method zone for a machine code frame. The first frame in a stack page is the baseFrame and is marked as such by a saved fp being its stackPage, in which case the first word on the stack is the caller context (possibly hybrid) beneath the base frame." | fxCallerSavedIP fxSavedFP fxMethod fxIFrameFlags fxThisContext fxIFReceiver fxMFReceiver fxIFSavedIP | fxCallerSavedIP := 1. fxSavedFP := 0. fxMethod := -1. fxThisContext := -2. fxIFrameFlags := -3. "Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP. Can find ``is block'' bit Can find ``has context'' bit" fxIFSavedIP := -4. fxIFReceiver := -5. fxMFReceiver := -3. "For debugging nil out values that differ in the StackInterpreter." FrameSlots := #undeclared. IFrameSlots := fxCallerSavedIP - fxIFReceiver + 1. MFrameSlots := fxCallerSavedIP - fxMFReceiver + 1. FoxCallerSavedIP := fxCallerSavedIP * BytesPerWord. "In Cog a base frame's caller context is stored on the first word of the stack page." FoxCallerContext := #undeclared. FoxSavedFP := fxSavedFP * BytesPerWord. FoxMethod := fxMethod * BytesPerWord. FoxThisContext := fxThisContext * BytesPerWord. FoxFrameFlags := #undeclared. FoxIFrameFlags := fxIFrameFlags * BytesPerWord. FoxIFSavedIP := fxIFSavedIP * BytesPerWord. FoxReceiver := #undeclared. FoxIFReceiver := fxIFReceiver * BytesPerWord. FoxMFReceiver := fxMFReceiver * BytesPerWord. "N.B. There is room for one more flag given the current 8 byte alignment of methods (which is at least needed to distinguish the checked and uncecked entry points by their alignment." MFMethodFlagHasContextFlag := 1. MFMethodFlagIsBlockFlag := 2. + MFMethodFlagFrameIsMarkedFlag := 4. "for pathTo:using:followWeak:" + MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag + MFMethodFlagFrameIsMarkedFlag. - MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag. MFMethodMask := (MFMethodFlagsMask + 1) negated! Item was added: + ----- Method: CoInterpreterPrimitives>>frameIsMarked: (in category 'object access primitives') ----- + frameIsMarked: theFPInt + | methodField | + methodField := stackPages longAt: theFPInt + FoxMethod. + ^methodField asUnsignedInteger < objectMemory startOfMemory + ifTrue: [(methodField bitAnd: 4) ~= 0] + ifFalse: [((stackPages longAt: theFPInt + FoxIFrameFlags) bitAnd: 2) ~= 0]! Item was added: + ----- Method: CoInterpreterPrimitives>>markFrame: (in category 'object access primitives') ----- + markFrame: theFPInt + | methodField | + methodField := stackPages longAt: theFPInt + FoxMethod. + methodField asUnsignedInteger < objectMemory startOfMemory + ifTrue: + [stackPages + longAt: theFPInt + FoxMethod + put: (methodField bitOr: 4)] + ifFalse: + [stackPages + longAt: theFPInt + FoxIFrameFlags + put: ((stackPages longAt: theFPInt + FoxIFrameFlags) bitOr: 2)]! Item was added: + ----- Method: CoInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') ----- + pathTo: goal using: stack followWeak: followWeak + "Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found. + If found, unmark, leaving path in stack, and answer 0. Otherwise answer an error: + PrimErrBadArgument if stack is not an Array + PrimErrBadIndex if search overflows stack + PrimErrNotFound if goal cannot be found" + | current hdr index next stackSize stackp freeStartAtStart | + (objectMemory isArray: stack) ifFalse: + [^PrimErrBadArgument]. + freeStartAtStart := objectMemory freeStart. "check no allocations during search" + objectMemory beRootIfOld: stack. "so no store checks are necessary on stack" + stackSize := objectMemory lengthOf: stack. + objectMemory mark: stack. + "no need. the current context is not reachable from the active process (suspendedContext is nil)" + "objectMemory mark: self activeProcess." + current := objectMemory specialObjectsOop. + objectMemory mark: current. + index := objectMemory lengthOf: current. + stackp := 0. + [[(index := index - 1) >= -1] whileTrue: + [next := (stackPages couldBeFramePointer: current) + ifTrue: + [index >= 0 + ifTrue: [self field: index ofFrame: current] + ifFalse: [objectMemory nilObject]] + ifFalse: + [index >= 0 + ifTrue: + [hdr := objectMemory baseHeader: current. + (objectMemory isContextHeader: hdr) + ifTrue: [self fieldOrSenderFP: index ofContext: current] + ifFalse: [objectMemory fetchPointer: index ofObject: current]] + ifFalse: + [objectMemory fetchClassOfNonInt: current]]. + (stackPages couldBeFramePointer: next) + ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))] + ifFalse: + [next >= heapBase ifTrue: + [self assert: (self checkOkayOop: next)]]. + next = goal ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory storePointer: stackp ofObject: stack withValue: current. + self pruneStack: stack stackp: stackp. + ^0]. + ((objectMemory isNonIntegerObject: next) + and: [(stackPages couldBeFramePointer: next) + ifTrue: [(self frameIsMarked: next) not] + ifFalse: + [next >= heapBase "exclude Cog methods" + and: [(objectMemory isMarked: next) not + and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next]) + and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]]]) + ifTrue: + [stackp + 2 > stackSize ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory nilFieldsOf: stack. + ^PrimErrBadIndex]. "PrimErrNoMemory ?" + objectMemory + storePointerUnchecked: stackp ofObject: stack withValue: current; + storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index). + stackp := stackp + 2. + (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *')) + ifTrue: + [self markFrame: next. + index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')] + ifFalse: + [hdr := objectMemory baseHeader: next. + objectMemory baseHeader: next put: (hdr bitOr: MarkBit). + (objectMemory isCompiledMethodHeader: hdr) + ifTrue: [index := self literalCountOf: next] + ifFalse: [index := objectMemory lengthOf: next]]. + current := next]]. + current = objectMemory specialObjectsOop ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory nilFieldsOf: stack. + ^PrimErrNotFound]. + index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack). + current := objectMemory fetchPointer: stackp - 2 ofObject: stack. + stackp := stackp - 2] repeat! Item was added: + ----- Method: CoInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') ----- + unmarkAllFrames + | thePage theFP methodField flags | + <var: #thePage type: #'StackPage *'> + <var: #theFP type: #'char *'> + <inline: false> + 0 to: numStackPages - 1 do: + [:i| + thePage := stackPages stackPageAt: i. + (stackPages isFree: thePage) ifFalse: + [theFP := thePage headFP. + [methodField := self longAt: theFP + FoxMethod. + methodField asUnsignedInteger < objectMemory startOfMemory + ifTrue: + [(methodField bitAnd: 4) ~= 0 ifTrue: + [self longAt: theFP + FoxMethod put: methodField - 4]] + ifFalse: + [flags := self longAt: theFP + FoxIFrameFlags. + (flags bitAnd: 2) ~= 0 ifTrue: + [self longAt: theFP + FoxIFrameFlags put: flags - 2]]. + (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]! Item was changed: ----- Method: CogMethodSurrogate>>nextOpenPIC (in category 'accessing') ----- nextOpenPIC | moField | moField := self methodObject. ^moField ~= 0 ifTrue: + [cogit cogMethodSurrogateAt: moField]! - [cogit cogMethodSurrogateAt: moField - self homeOffset]! Item was changed: ----- Method: CogObjectRepresentationForSqueakV3>>couldBeObject: (in category 'garbage collection') ----- couldBeObject: oop ^(objectMemory isNonIntegerObject: oop) + and: [self oop: oop isGreaterThanOrEqualTo: objectMemory nilObject]! - and: [oop asUnsignedInteger >= objectMemory nilObject]! Item was changed: ----- Method: CogObjectRepresentationForSqueakV3>>shouldAnnotateObjectReference: (in category 'garbage collection') ----- shouldAnnotateObjectReference: anOop "self assert: ((objectMemory isIntegerObject: anOop) or: [objectMemory addressCouldBeObj: anOop])." ^(objectMemory isNonIntegerObject: anOop) + and: [self oop: anOop isGreaterThan: objectMemory trueObject]! - and: [anOop > objectMemory trueObject]! Item was changed: CogClass subclass: #Cogit instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMissCall missOffset entryPointMask checkedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceStoreCheckTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceClosureCopyTrampoline ceCreateNewArrayTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceActiveContextTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline cePositive32BitIntegerTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB' + classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxUnitDisplacement MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass YoungSelectorInPIC' - classVariableNames: 'AltBlockCreationBytecodeSize AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxUnitDisplacement MaxUnreportableError MaxX2NDisplacement MethodTooBig NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass YoungSelectorInPIC' poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets' category: 'VMMaker-JIT'! Cogit class instanceVariableNames: 'generatorTable primitiveTable'! !Cogit commentStamp: 'eem 2/13/2013 15:37' prior: 0! I am the code generator for the Cog VM. My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance. I can be tested in the current image using my class-side in-image compilation facilities. e.g. try StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib) I have concrete subclasses that implement different levels of optimization: SimpleStackBasedCogit is the simplest code generator. StackToRegisterMappingCogit is the current production code generator It defers pushing operands to the stack until necessary and implements a register-based calling convention for low-arity sends. StackToRegisterMappingCogit is an experimental code generator with support for counting conditional branches, intended to support adaptive optimization. coInterpreter <CoInterpreterSimulator> the VM's interpreter with which I cooperate methodZoneManager <CogMethodZoneManager> the manager of the machine code zone objectRepresentation <CogObjectRepresentation> the object used to generate object accesses processor <BochsIA32Alien|?> the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk simulatedTrampolines <Dictionary of Integer -> MessageSend> the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time. simulatedVariableGetters <Dictionary of Integer -> MessageSend> the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time. simulatedVariableSetters <Dictionary of Integer -> MessageSend> the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time. printRegisters printInstructions clickConfirm <Boolean> flags controlling debug printing and code simulation breakPC <Integer> machine code pc breakpoint cFramePointer cStackPointer <Integer> the variables representing the C stack & frame pointers, which must change on FFI callback and return selectorOop <sqInt> the oop of the methodObj being compiled methodObj <sqInt> the bytecode method being compiled initialPC endPC <Integer> the start and end pcs of the methodObj being compiled methodOrBlockNumArgs <Integer> argument count of current method or block being compiled needsFrame <Boolean> whether methodObj or block needs a frame to execute primitiveIndex <Integer> primitive index of current method being compiled methodLabel <CogAbstractOpcode> label for the method header blockEntryLabel <CogAbstractOpcode> label for the start of the block dispatch code stackOverflowCall <CogAbstractOpcode> label for the call of ceStackOverflow in the method prolog sendMissCall <CogAbstractOpcode> label for the call of ceSICMiss in the method prolog entryOffset <Integer> offset of method entry code from start (header) of method entry <CogAbstractOpcode> label for the first instruction of the method entry code noCheckEntryOffset <Integer> offset of the start of a method proper (after the method entry code) from start (header) of method noCheckEntry <CogAbstractOpcode> label for the first instruction of start of a method proper fixups <Array of <AbstractOpcode Label | nil>> the labels for forward jumps that will be fixed up when reaching the relevant bytecode. fixup shas one element per byte in methodObj's bytecode abstractOpcodes <Array of <AbstractOpcode>> the code generated when compiling methodObj byte0 byte1 byte2 byte3 <Integer> individual bytes of current bytecode being compiled in methodObj bytecodePointer <Integer> bytecode pc (same as Smalltalk) of the current bytecode being compiled opcodeIndex <Integer> the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist) numAbstractOpcodes <Integer> the number of elements in abstractOpcocdes blockStarts <Array of <BlockStart>> the starts of blocks in the current method blockCount the index into blockStarts as they are being noted, and hence eventuakly teh total number of blocks in the current method labelCounter <Integer> a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about ceStackOverflowTrampoline <Integer> ceSend0ArgsTrampoline <Integer> ceSend1ArgsTrampoline <Integer> ceSend2ArgsTrampoline <Integer> ceSendNArgsTrampoline <Integer> ceSendSuper0ArgsTrampoline <Integer> ceSendSuper1ArgsTrampoline <Integer> ceSendSuper2ArgsTrampoline <Integer> ceSendSuperNArgsTrampoline <Integer> ceSICMissTrampoline <Integer> ceCPICMissTrampoline <Integer> ceStoreCheckTrampoline <Integer> ceReturnToInterpreterTrampoline <Integer> ceBaseFrameReturnTrampoline <Integer> ceSendMustBeBooleanTrampoline <Integer> ceClosureCopyTrampoline <Integer> the various trampolines (system-call-like jumps from machine code to the run-time). See Cogit>>generateTrampolines for the mapping from trampoline to run-time routine and then read the run-time routine for a funcitonal description. ceEnterCogCodePopReceiverReg <Integer> the enilopmart (jump from run-time to machine-code) methodZoneBase <Integer> ! Cogit class instanceVariableNames: 'generatorTable primitiveTable'! Item was changed: ----- Method: Cogit class>>initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') ----- initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid "SimpleStackBasedCogit initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid" "StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid" | v3Table v4Table | "N.B. Must do it backwards to evaluate AltBlockCreationBytecodeSize & BlockCreationBytecodeSize correctly." self initializeBytecodeTableForNewspeakV4. v4Table := generatorTable. AltBlockCreationBytecodeSize := BlockCreationBytecodeSize. + AltNSSendIsPCAnnotated := NSSendIsPCAnnotated. self initializeBytecodeTableForNewspeakV3PlusClosures. v3Table := generatorTable. generatorTable := CArrayAccessor on: v3Table object, v4Table object! Item was changed: ----- Method: Cogit class>>initializeErrorCodes (in category 'class initialization') ----- initializeErrorCodes - self flag: 'these should be positive quantities and the check for error code should be a comparison against minCogMethodAddress/methodZoneBase'. NotFullyInitialized := -1. InsufficientCodeSpace := -2. MethodTooBig := -4. YoungSelectorInPIC := -5. - MaxUnreportableError := YoungSelectorInPIC. EncounteredUnknownBytecode := -6. MaxNegativeErrorCode := EncounteredUnknownBytecode! Item was changed: ----- Method: Cogit class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') ----- isNonArgumentImplicitReceiverVariableName: aString + ^#('cogit' + 'coInterpreter' - ^#('cogit' 'coInterpreter' 'methodZone' + 'objectMemory' + 'objectRepresentation' + 'self') includes: aString! - 'objectMemory' 'objectRepresentation') includes: aString! Item was changed: ----- Method: Cogit class>>testPCMappingFor: (in category 'tests') ----- testPCMappingFor: aCompiledMethod + ^self testPCMappingFor: aCompiledMethod options: #()! - | tuple | - tuple := self cog: aCompiledMethod selector: aCompiledMethod selector. - tuple second testPCMappingForMethod: tuple last! Item was added: + ----- Method: Cogit class>>testPCMappingFor:options: (in category 'tests') ----- + testPCMappingFor: aCompiledMethod options: optionsDictionaryOrArray + | tuple | + tuple := self cog: aCompiledMethod selector: aCompiledMethod selector options: optionsDictionaryOrArray. + tuple second testPCMappingForMethod: tuple last! Item was changed: ----- Method: Cogit class>>testPCMappingSelect: (in category 'tests') ----- testPCMappingSelect: aBlock "Test pc mapping both ways using the methods in the current image" + self testPCMappingSelect: aBlock options: #()! - | cogit coInterpreter | - self initialize. - cogit := self new. - coInterpreter := CurrentImageCoInterpreterFacade new cogit: cogit; yourself. - [cogit - setInterpreter: coInterpreter; - singleStep: true; - initializeCodeZoneFrom: 1024 upTo: coInterpreter memory size] - on: Notification - do: [:ex| - (ex messageText beginsWith: 'cannot find receiver for') ifTrue: - [ex resume: coInterpreter]]. - SystemNavigation new allSelect: - [:m| | cm | - (m isQuick not - and: [aBlock value: m]) ifTrue: - [Transcript nextPut: $.; flush. - [cm := cogit - cog: (coInterpreter oopForObject: m) - selector: (coInterpreter oopForObject: m selector). - cm isNil and: [coInterpreter isCogCompiledCodeCompactionCalledFor]] whileTrue: - [cogit methodZone clearCogCompiledCode. - coInterpreter clearCogCompiledCodeCompactionCalledFor. - coInterpreter initializeObjectMap]. - cogit testPCMappingForMethod: cm]. - false]! Item was added: + ----- Method: Cogit class>>testPCMappingSelect:options: (in category 'tests') ----- + testPCMappingSelect: aBlock options: optionsDictionaryOrArray + "Test pc mapping both ways using the methods in the current image" + | cogit coInterpreter | + self initializeWithOptions: (self asOptionsDictionary: optionsDictionaryOrArray). + cogit := self new. + coInterpreter := CurrentImageCoInterpreterFacade new cogit: cogit; yourself. + [cogit + setInterpreter: coInterpreter; + singleStep: true; + initializeCodeZoneFrom: 1024 upTo: coInterpreter memory size] + on: Notification + do: [:ex| + (ex messageText beginsWith: 'cannot find receiver for') ifTrue: + [ex resume: coInterpreter]]. + SystemNavigation new allSelect: + [:m| | cm | + (m isQuick not + and: [aBlock value: m]) ifTrue: + [Transcript nextPut: $.; flush. + [cm := cogit + cog: (coInterpreter oopForObject: m) + selector: (coInterpreter oopForObject: m selector). + cm isNil and: [coInterpreter isCogCompiledCodeCompactionCalledFor]] whileTrue: + [cogit methodZone clearCogCompiledCode. + coInterpreter clearCogCompiledCodeCompactionCalledFor. + coInterpreter initializeObjectMap]. + cogit testPCMappingForMethod: cm]. + false]! Item was changed: ----- Method: Cogit>>ceSICMiss: (in category 'in-line cacheing') ----- ceSICMiss: receiver "An in-line cache check in a method has failed. The failing entry check has jumped to the ceMethodAbort abort call at the start of the method which has called this routine. If possible allocate a closed PIC for the current and existing classes. The stack looks like: receiver args sender return address sp=> ceMethodAbort call return address So we can find the method that did the failing entry check at ceMethodAbort call return address - missOffset and we can find the send site from the outer return address." <api> | pic innerReturn outerReturn entryPoint targetMethod newTargetMethodOrNil errorSelectorOrNil cacheTag extent result | <var: #pic type: #'CogMethod *'> <var: #targetMethod type: #'CogMethod *'> "Whether we can relink to a PIC or not we need to pop off the inner return and identify the target method." innerReturn := coInterpreter popStack. targetMethod := self cCoerceSimple: innerReturn - missOffset to: #'CogMethod *'. outerReturn := coInterpreter stackTop. self assert: (outerReturn between: methodZoneBase and: methodZone freeStart). entryPoint := backEnd callTargetFromReturnAddress: outerReturn. self assert: targetMethod selector ~= objectMemory nilObject. self cppIf: NewspeakVM ifTrue: [self assert: (targetMethod asInteger + cmEntryOffset = entryPoint or: [targetMethod asInteger + cmDynSuperEntryOffset = entryPoint]). "Avoid the effort of implementing PICs for the relatively low dynamic frequency dynamic super send and simply rebind the send site." targetMethod asInteger + cmDynSuperEntryOffset = entryPoint ifTrue: [^coInterpreter ceDynamicSuperSend: targetMethod selector to: receiver numArgs: targetMethod cmNumArgs]]. self assert: targetMethod asInteger + cmEntryOffset = entryPoint. self lookup: targetMethod selector for: receiver methodAndErrorSelectorInto: [:method :errsel| newTargetMethodOrNil := method. errorSelectorOrNil := errsel]. "We assume lookupAndCog:for: will *not* reclaim the method zone" self assert: outerReturn = coInterpreter stackTop. cacheTag := objectRepresentation inlineCacheTagForInstance: receiver. ((errorSelectorOrNil notNil and: [errorSelectorOrNil ~= SelectorDoesNotUnderstand]) or: [(objectRepresentation inlineCacheTagIsYoung: cacheTag) or: [newTargetMethodOrNil isNil or: [objectMemory isYoung: newTargetMethodOrNil]]]) ifTrue: [result := self patchToOpenPICFor: targetMethod selector numArgs: targetMethod cmNumArgs receiver: receiver. self assert: result not. "If patchToOpenPICFor:.. returns we're out of code memory" ^coInterpreter ceSendFromInLineCacheMiss: targetMethod]. "See if an Open PIC is already available." pic := methodZone openPICWithSelector: targetMethod selector. pic isNil ifTrue: ["otherwise attempt to create a closed PIC for the two cases." pic := self cogPICSelector: targetMethod selector numArgs: targetMethod cmNumArgs Case0Method: targetMethod Case1Method: newTargetMethodOrNil tag: cacheTag isMNUCase: errorSelectorOrNil = SelectorDoesNotUnderstand. + pic asInteger < 0 ifTrue: + ["For some reason the PIC couldn't be generated, most likely a lack of code memory. + Continue as if this is an unlinked send." - (errorSelectorOrNil notNil - or: [pic asInteger between: MaxNegativeErrorCode and: -1]) ifTrue: - ["If for some reason the PIC couldn't be generated, most likely a lack of code memory. - Continue as if this is an unlinked send. If this is an error case continue as if this is an - unlinked send to invoke the appropriate error behavior (MNU, cannot interpret et al)." pic asInteger = InsufficientCodeSpace ifTrue: [coInterpreter callForCogCompiledCodeCompaction]. + ^coInterpreter ceSendFromInLineCacheMiss: targetMethod]. + processor flushICacheFrom: pic asInteger to: pic asInteger + closedPICSize]. + "Relink the send site to the pic." - ^coInterpreter ceSendFromInLineCacheMiss: targetMethod]]. extent := backEnd rewriteCallAt: outerReturn target: pic asInteger + cmEntryOffset. + processor flushICacheFrom: outerReturn - 1 - extent to: outerReturn - 1. - processor - flushICacheFrom: outerReturn - 1 - extent to: outerReturn - 1; - flushICacheFrom: pic asInteger to: pic asInteger + closedPICSize. "Jump back into the pic at its entry in case this is an MNU (newTargetMethodOrNil is nil)" coInterpreter executeCogMethodFromLinkedSend: pic withReceiver: receiver andCacheTag: (backEnd inlineCacheTagAt: outerReturn). "NOTREACHED" ^nil! Item was changed: ----- Method: Cogit>>cog:selector: (in category 'jit - api') ----- cog: aMethodObj selector: aSelectorOop "Attempt to produce a machine code method for the bytecode method object aMethodObj. N.B. If there is no code memory available do *NOT* attempt to reclaim the method zone. Certain clients (e.g. ceSICMiss:) depend on the zone remaining constant across method generation." <api> <returnTypeC: #'CogMethod *'> | cogMethod | <var: #cogMethod type: #'CogMethod *'> self assert: ((coInterpreter methodHasCogMethod: aMethodObj) not or: [(self noAssertMethodClassAssociationOf: aMethodObj) = objectMemory nilObject]). "coInterpreter stringOf: aSelectorOop" coInterpreter compilationBreak: aSelectorOop point: (objectMemory lengthOf: aSelectorOop). aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod']. self cppIf: NewspeakVM ifTrue: [cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop. cogMethod ifNotNil: [(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue: [self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader. cogMethod methodObject: aMethodObj. coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger]. ^cogMethod]]. "If the generators for the alternate bytecode set are missing then interpret." (coInterpreter methodUsesAlternateBytecodeSet: aMethodObj) + ifTrue: + [(self numElementsIn: generatorTable) <= 256 ifTrue: + [^nil]. - ifTrue: [ - (self cCode: 'numElementsIn(generatorTable)') <= 256 - ifTrue: [ ^nil ]. bytecodeSetOffset := 256] ifFalse: [bytecodeSetOffset := 0]. extA := extB := 0. methodObj := aMethodObj. cogMethod := self compileCogMethod: aSelectorOop. (cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue: + [cogMethod asUnsignedInteger = InsufficientCodeSpace ifTrue: + [coInterpreter callForCogCompiledCodeCompaction]. + "Right now no errors should be reported, so nothing more to do." + "self reportError: (self cCoerceSimple: cogMethod to: #sqInt)." - [cogMethod asInteger >= MaxUnreportableError - ifTrue: - [cogMethod asInteger = InsufficientCodeSpace ifTrue: - [coInterpreter callForCogCompiledCodeCompaction]] - ifFalse: - [self reportError: (self cCoerceSimple: cogMethod to: #sqInt)]. ^nil]. "self cCode: '' inSmalltalk: [coInterpreter printCogMethod: cogMethod. ""coInterpreter symbolicMethod: aMethodObj."" self assertValidMethodMap: cogMethod." "self disassembleMethod: cogMethod." "printInstructions := clickConfirm := true""]." ^cogMethod! Item was removed: - ----- Method: Cogit>>isPCMappedAnnotation: (in category 'method map') ----- - isPCMappedAnnotation: annotation - <inline: true> - ^(self isSendAnnotation: annotation) - or: [annotation = HasBytecodePC]! Item was added: + ----- Method: Cogit>>isPCMappedAnnotation:alternateInstructionSet: (in category 'method map') ----- + isPCMappedAnnotation: annotation alternateInstructionSet: isAlternateInstSet + <inline: true> + ^self cppIf: NewspeakVM + ifTrue: + "For Newspeak we shoe-horn in implicit receiver inline cache handling as an inline + send, since these caches are processed similarly to inline send caches. But if + the Newspeak instruction set includes an absent receiver send then there are + two map entries for the one bytecode, the first for the implicit receiver cache + and the second for the send cache. Only one of these can function as the pc- + mapped entry since there is only one bytecode. c.f. isSendAnnotation:" + [annotation = IsSendCall + or: [(annotation = IsNSSendCall + and: [isAlternateInstSet + ifTrue: [AltNSSendIsPCAnnotated] + ifFalse: [NSSendIsPCAnnotated]]) + or: [annotation = HasBytecodePC]]] + ifFalse: + [(self isSendAnnotation: annotation) + or: [annotation = HasBytecodePC]]! Item was changed: ----- Method: Cogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') ----- mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg "Machine-code <-> bytecode pc mapping support. Evaluate functionSymbol for each mcpc, bcpc pair in the map until the function returns non-zero, answering that result, or 0 if it fails to. This works only for frameful methods." <var: #cogMethod type: #'CogBlockMethod *'> <var: #functionSymbol declareC: 'sqInt (*functionSymbol)(char *mcpc, sqInt bcpc, void *arg)'> <var: #arg type: #'void *'> | isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result latestContinuation byte descriptor bsOffset nExts | <var: #descriptor type: #'BytecodeDescriptor *'> <var: #homeMethod type: #'CogMethod *'> self assert: cogMethod stackCheckOffset > 0. "In both CMMethod and CMBlock cases find the start of the map and skip forward to the bytecode pc map entry for the stack check." cogMethod cmType = CMMethod ifTrue: [isInBlock := false. homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'. self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader). map := self mapStartFor: homeMethod. self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]). latestContinuation := startbcpc. aMethodObj := homeMethod methodObject. endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1. bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader] ifFalse: [isInBlock := true. homeMethod := cogMethod cmHomeMethod. map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod) inMethod: homeMethod. self assert: map ~= 0. self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial" or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]). [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue: [map := map - 1]. map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header." aMethodObj := homeMethod methodObject. bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader). bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader. byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset. descriptor := self generatorAt: byte. endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj]. bcpc := startbcpc. mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset. nExts := 0. "The stack check maps to the start of the first bytecode, the first bytecode being effectively after frame build." result := self perform: functionSymbol with: (self cCoerceSimple: mcpc to: #'char *') with: startbcpc with: arg. result ~= 0 ifTrue: [^result]. "Now skip up through the bytecode pc map entry for the stack check." [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue: [map := map - 1]. map := map - 1. [(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc" [mapByte >= FirstAnnotation ifTrue: [| annotation nextBcpc | annotation := mapByte >> AnnotationShift. mcpc := mcpc + (mapByte bitAnd: DisplacementMask). + (self isPCMappedAnnotation: annotation alternateInstructionSet: bsOffset > 0) ifTrue: - (self isPCMappedAnnotation: annotation) ifTrue: [[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset. descriptor := self generatorAt: byte. isInBlock ifTrue: [bcpc >= endbcpc ifTrue: [^0]] ifFalse: + [(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0]. - [(descriptor isReturn and: [bcpc > latestContinuation]) ifTrue: [^0]. (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue: [| targetPC | targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj. latestContinuation := latestContinuation max: targetPC]]. nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj. descriptor isMapped or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse: [bcpc := nextBcpc. nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]. "All subsequent bytecodes except backward branches map to the following bytecode. Backward branches map to themselves other- wise mapping could cause premature breaking out of loops." result := self perform: functionSymbol with: (self cCoerceSimple: mcpc to: #'char *') with: ((descriptor isBranch and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj]) ifTrue: [bcpc] ifFalse: [bcpc + descriptor numBytes]) with: arg. result ~= 0 ifTrue: [^result]. bcpc := nextBcpc. nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]] ifFalse: [mcpc := mcpc + (mapByte >= DisplacementX2N ifTrue: [mapByte - DisplacementX2N << AnnotationShift] ifFalse: [mapByte])]. map := map - 1]. ^0! Item was changed: ----- Method: Cogit>>printMapEntry:mcpc:args: (in category 'disassembly') ----- printMapEntry: annotation mcpc: mcpc args: tupleOfStreamCodeRangesAndMethod "Print the Map entry's mcpc, its annotation and the corresponding bytecode pc, if any." <doNotGenerate> + [:aStream :codeRanges :cogMethod| | isAltInstSet | + isAltInstSet := coInterpreter headerIndicatesAlternateBytecodeSet: cogMethod methodHeader. - [:aStream :codeRanges :cogMethod| self startMcpcAndCogMethodForMcpc: mcpc in: cogMethod do: [:startmcpc :subMethod| | name codeRange | "Find the start of the block by searching the code ranges." codeRange := codeRanges detect: [:range| range includes: mcpc]. codeRange first = mcpc ifTrue: [aStream nextPutAll: 'startpc: '; print: codeRange startpc; cr]. aStream next: 2 put: Character space; nextPutAll: mcpc hex; space; nextPutAll: (name := self class annotationConstantNames at: annotation + 1); next: 20 - name size put: Character space; nextPut: $(; nextPutAll: (self findMapLocationForMcpc: mcpc inMethod: cogMethod) hex. + (self isPCMappedAnnotation: annotation alternateInstructionSet: isAltInstSet) ifTrue: - (self isPCMappedAnnotation: annotation) ifTrue: [aStream nextPutAll: ', bc: '; print: (self bytecodePCFor: mcpc startBcpc: codeRange startpc in: subMethod)]. (self isSendAnnotation: annotation) ifTrue: [| sel | sel := self selectorForSendAt: mcpc annotation: annotation. sel isInteger ifTrue: [sel := self lookupAddress: sel]. sel isString ifTrue: [aStream space; nextPutAll: sel]]. aStream nextPut: $); cr; flush]] valueWithArguments: tupleOfStreamCodeRangesAndMethod. ^0! Item was changed: ----- Method: Cogit>>testMcToBcPcMappingForMethod: (in category 'tests-method map') ----- testMcToBcPcMappingForMethod: cogMethod <doNotGenerate> + | bcMethod subMethods prevMcpc isAltInstSet | - | bcMethod subMethods prevMcpc | "self disassembleMethod: cogMethod" "coInterpreter symbolicMethod: cogMethod methodObject" "coInterpreter printOop: cogMethod methodObject" "self printPCMapPairsFor: cogMethod on: Transcript" cogMethod stackCheckOffset = 0 ifTrue: "frameless" [^self]. bcMethod := coInterpreter isCurrentImageFacade ifTrue: [coInterpreter objectForOop: cogMethod methodObject] ifFalse: [VMCompiledMethodProxy new for: cogMethod methodObject coInterpreter: coInterpreter objectMemory: objectMemory]. subMethods := self subMethodsAsRangesFor: cogMethod. + isAltInstSet := coInterpreter headerIndicatesAlternateBytecodeSet: cogMethod methodHeader. self mapFor: cogMethod do: [:annotation :mcpc| | subMethod bcpc mappedpc | + (self isPCMappedAnnotation: annotation alternateInstructionSet: isAltInstSet) ifTrue: - (self isPCMappedAnnotation: annotation) ifTrue: [subMethod := subMethods detect: [:range| range includes: mcpc] ifNone: ["a trailing call ceNonLocalReturnTrampoline's following pc is the start of a following block or the end of the map" subMethods detect: [:range| range includes: mcpc - 1]]. mcpc > subMethod first ifTrue: [bcpc := self bytecodePCFor: mcpc startBcpc: subMethod startpc in: subMethod cogMethod. self assert: bcpc ~= 0. mappedpc := self mcPCFor: bcpc startBcpc: subMethod startpc in: subMethod cogMethod. self assert: mappedpc ~= 0. mappedpc := mappedpc + subMethod cogMethod address. "mcpc = mappedpc is obviously what we want and expect. PrevMcpc = mappedpc hacks around frame building accessors where the frst bytecode is mapped twice, once for the stack check and once for the context inst var access. The bytecode pc can only map back to a single mcpc, the first, so the second map entry will fail without this hack." self assert: (mcpc = mappedpc or: [prevMcpc = mappedpc]). (self isSendAnnotation: annotation) ifTrue: [| mcSelector bcSelector | mcSelector := self selectorForSendAt: mcpc annotation: annotation. "sends map to the following pc. need to find the selector for the previous pc" bcSelector := self selectorForSendBefore: bcpc in: bcMethod. self assert: mcSelector = bcSelector]]. prevMcpc := mcpc]. false "keep scanning"]! Item was changed: ----- Method: Cogit>>unlinkIfLinkedSend:pc:ignored: (in category 'in-line cacheing') ----- unlinkIfLinkedSend: annotation pc: mcpc ignored: superfluity <var: #mcpc type: #'char *'> | entryPoint targetMethod offset sendTable unlinkedRoutine | <var: #targetMethod type: #'CogMethod *'> <var: #sendTable type: #'sqInt *'> (self isSendAnnotation: annotation) ifTrue: [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger. + entryPoint > methodZoneBase + ifTrue: "It's a linked send." + [self + offsetAndSendTableFor: entryPoint + annotation: annotation + into: [:off :table| offset := off. sendTable := table]. + targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'. + unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1). + backEnd + rewriteInlineCacheAt: mcpc asInteger + tag: targetMethod selector + target: unlinkedRoutine] + ifFalse: + [self cppIf: NewspeakVM ifTrue: + [entryPoint = ceImplicitReceiverTrampoline ifTrue: + [backEnd + unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize put: 0; + unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop put: 0]]]]. - entryPoint > methodZoneBase ifTrue: "It's a linked send." - [self - offsetAndSendTableFor: entryPoint - annotation: annotation - into: [:off :table| offset := off. sendTable := table]. - targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'. - unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1). - backEnd - rewriteInlineCacheAt: mcpc asInteger - tag: targetMethod selector - target: unlinkedRoutine]]. ^0 "keep scanning"! Item was changed: ----- Method: Cogit>>unlinkIfLinkedSend:pc:of: (in category 'in-line cacheing') ----- unlinkIfLinkedSend: annotation pc: mcpc of: theSelector <var: #mcpc type: #'char *'> | entryPoint targetMethod offset sendTable unlinkedRoutine | <var: #targetMethod type: #'CogMethod *'> <var: #sendTable type: #'sqInt *'> (self isSendAnnotation: annotation) ifTrue: [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger. + entryPoint > methodZoneBase + ifTrue: "It's a linked send." + [self + offsetAndSendTableFor: entryPoint + annotation: annotation + into: [:off :table| offset := off. sendTable := table]. + targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'. + targetMethod selector = theSelector ifTrue: + [unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1). + backEnd + rewriteInlineCacheAt: mcpc asInteger + tag: targetMethod selector + target: unlinkedRoutine. + codeModified := true]] + ifFalse: + [self cppIf: NewspeakVM ifTrue: + [entryPoint = ceImplicitReceiverTrampoline ifTrue: + [(backEnd inlineCacheTagAt: mcpc asInteger) = theSelector ifTrue: + [backEnd + unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize put: 0; + unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop put: 0]]]]]. - self cppIf: NewspeakVM ifTrue: - [entryPoint = ceImplicitReceiverTrampoline ifTrue: - [(backEnd inlineCacheTagAt: mcpc asInteger) = theSelector ifTrue: - [backEnd - unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize put: 0; - unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop put: 0]]]. - entryPoint > methodZoneBase ifTrue: "It's a linked send." - [self - offsetAndSendTableFor: entryPoint - annotation: annotation - into: [:off :table| offset := off. sendTable := table]. - targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'. - targetMethod selector = theSelector ifTrue: - [unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1). - backEnd - rewriteInlineCacheAt: mcpc asInteger - tag: targetMethod selector - target: unlinkedRoutine. - codeModified := true]]]. ^0 "keep scanning"! Item was changed: ----- Method: Cogit>>unlinkIfLinkedSend:pc:to: (in category 'in-line cacheing') ----- unlinkIfLinkedSend: annotation pc: mcpc to: theCogMethod <var: #mcpc type: #'char *'> | entryPoint targetMethod offset sendTable unlinkedRoutine | <var: #targetMethod type: #'CogMethod *'> <var: #sendTable type: #'sqInt *'> (self isSendAnnotation: annotation) ifTrue: [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger. + entryPoint > methodZoneBase + ifTrue: "It's a linked send." + [self + offsetAndSendTableFor: entryPoint + annotation: annotation + into: [:off :table| offset := off. sendTable := table]. + targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'. + targetMethod asInteger = theCogMethod ifTrue: + [unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1). + backEnd + rewriteInlineCacheAt: mcpc asInteger + tag: targetMethod selector + target: unlinkedRoutine. + codeModified := true]] + ifFalse: "Can't tell the target with PushReciver/SendImplicit so flush anyway." + [self cppIf: NewspeakVM ifTrue: + [entryPoint = ceImplicitReceiverTrampoline ifTrue: + [backEnd + unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize put: 0; + unalignedLongAt: mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop put: 0]]]]. - entryPoint > methodZoneBase ifTrue: "It's a linked send." - [self - offsetAndSendTableFor: entryPoint - annotation: annotation - into: [:off :table| offset := off. sendTable := table]. - targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'. - targetMethod asInteger = theCogMethod ifTrue: - [unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1). - backEnd - rewriteInlineCacheAt: mcpc asInteger - tag: targetMethod selector - target: unlinkedRoutine. - codeModified := true]]]. ^0 "keep scanning"! Item was changed: ----- Method: Cogit>>unlinkSendsTo:andFreeIf: (in category 'jit - api') ----- unlinkSendsTo: targetMethodObject andFreeIf: freeIfTrue <api> "Unlink all sends in cog methods to a particular target method. If targetMethodObject isn't actually a method (perhaps being + used via invokeAsMethod) then there's nothing to do." - used via invokeAsMethod) then flush all sends since anything - could be affected." | cogMethod targetMethod freedPIC | <var: #cogMethod type: #'CogMethod *'> <var: #targetMethod type: #'CogMethod *'> ((objectMemory isOopCompiledMethod: targetMethodObject) and: [coInterpreter methodHasCogMethod: targetMethodObject]) ifFalse: [^self]. targetMethod := coInterpreter cogMethodOf: targetMethodObject. methodZoneBase isNil ifTrue: [^self]. codeModified := freedPIC := false. cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'. [cogMethod < methodZone limitZony] whileTrue: [cogMethod cmType = CMMethod ifTrue: [self mapFor: cogMethod performUntil: #unlinkIfLinkedSend:pc:to: arg: targetMethod asInteger] ifFalse: [(cogMethod cmType = CMClosedPIC and: [self cPIC: cogMethod HasTarget: targetMethod]) ifTrue: [methodZone freeMethod: cogMethod. freedPIC := true]]. cogMethod := methodZone methodAfter: cogMethod]. freeIfTrue ifTrue: [self freeMethod: targetMethod]. freedPIC ifTrue: [self unlinkSendsToFree] ifFalse: [codeModified ifTrue: "After possibly updating inline caches we need to flush the icache." [processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]]! Item was added: + ----- Method: CurrentImageCoInterpreterFacade>>addressCouldBeObj: (in category 'debug support') ----- + addressCouldBeObj: address + ^(address bitAnd: 3) = 0 + and: [self addressCouldBeOop: address]! Item was changed: ----- Method: CurrentImageCoInterpreterFacade>>objectForOop: (in category 'private-cacheing') ----- objectForOop: anOop "This is a keyAtValue: search and so needs speeding up either by a reverse map or a simple cache." ^(anOop bitAnd: 3) caseOf: { [0] -> [anOop = cachedOop ifTrue: [cachedObject] + ifFalse: [cachedObject := objectMap keyAtValue: anOop. "may raise Error" + cachedOop := anOop. "Dom't assign until accessed without error" + cachedObject]]. - ifFalse: [cachedObject := objectMap keyAtValue: (cachedOop := anOop)]]. [1] -> [anOop signedIntFromLong >> 1]. [3] -> [anOop signedIntFromLong >> 1] }! Item was added: + ----- Method: CurrentImageCoInterpreterFacade>>unalignedLongAt: (in category 'accessing') ----- + unalignedLongAt: index + ^memory unsignedLongAt: index + 1! Item was changed: ----- Method: HostWindowPlugin>>primitiveShowHostWindow:bits:width:height:depth:left:right:top:bottom: (in category 'system primitives') ----- primitiveShowHostWindow: windowIndex bits: dispBits width: w height: h depth: d left: left right: right top: top bottom: bottom "Host window analogue of DisplayScreen> primShowRectLeft:right:top:bottom: (Interpreter>primitiveShowDisplayRect) which takes the window index, bitmap details and the rectangle bounds. Fail if the windowIndex is invalid or the platform routine returns false to indicate failure" |ok| - <var: #dispBits type: #'unsigned char *'> self primitive: 'primitiveShowHostWindowRect' parameters: #(SmallInteger WordArray SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger). "Tell the vm to copy pixel's from dispBits to the screen - this is just ioShowDisplay with the extra parameter of the windowIndex integer" ok := self cCode: 'ioShowDisplayOnWindow(dispBits, w, h, d, left, right, top, bottom, windowIndex)'. ok ifFalse:[interpreterProxy primitiveFail]! Item was changed: ----- Method: IA32ABIPlugin>>primInLibraryFindSymbol (in category 'primitives-library loading') ----- primInLibraryFindSymbol "Attempt to find the address of a symbol in a loaded library. The primitive can have a signature either of the form: <Anywhere> primInLibrary: libraryHandle <Alien> findSymbol: symbolName <String> ^<Integer> <primitive: 'primInLibraryFindSymbol' error: errorCode module: 'IA32ABI'> or: libraryHandle <Alien> primFindSymbol: symbolName <String> ^<Integer> <primitive: 'primInLibraryFindSymbol' error: errorCode module: 'IA32ABI'>" - | functionName libraryProxy address | <export: true> + | functionName libraryProxy address | + <var: #address type: #'void *'> functionName := interpreterProxy stackValue: 0. libraryProxy := interpreterProxy stackValue: 1. ((self isAlien: libraryProxy) and: [(interpreterProxy byteSizeOf: libraryProxy) >= 2 * BytesPerOop and: [interpreterProxy isBytes: functionName]]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. address := interpreterProxy ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: functionName) + to: #sqInt) - to: 'sqInt') OfLength: (interpreterProxy byteSizeOf: functionName) FromModule: (self longAt: libraryProxy + BaseHeaderSize + BytesPerOop). (interpreterProxy failed or: [address = 0]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNotFound]. + interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: address asUnsignedInteger)! - interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: address)! Item was changed: ----- Method: IA32ABIPlugin>>primLoadLibrary (in category 'primitives-library loading') ----- primLoadLibrary "Attempt to load a library of the given name. The primitive will have a signature of the form: <Anywhere> primLoadLibrary: libraryName <String> ^<Integer> <primitive: 'primLoadLibrary' error: errorCode module: 'IA32ABI'>" - | libraryName libraryHandle | <export: true> + | libraryName libraryHandle | + <var: #libraryHandle type: #'void *'> libraryName := interpreterProxy stackValue: 0. (interpreterProxy isBytes: libraryName) ifFalse: [^ interpreterProxy primitiveFailFor: PrimErrBadArgument]. libraryHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: libraryName) to: 'sqInt') OfLength: (interpreterProxy byteSizeOf: libraryName). libraryHandle = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNotFound]. + interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: libraryHandle asUnsignedInteger)! - interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: libraryHandle)! Item was changed: ----- Method: IA32ABIPlugin>>primReturnAsFromContextThrough (in category 'primitives-callbacks') ----- primReturnAsFromContextThrough "Return a result from a callback to the callback's callee. The primitive + has a signature of either of the forms: - has a signature of the form: result <VMCallbackContext32/64> primReturnAs: returnTypeCode <Integer> FromContext: callbackContext <Context> + result <VMCallbackContext32/64> + primSignal: aSemaphore <Semaphore> + andReturnAs: returnTypeCode <Integer> + FromContext: callbackContext <Context> + <primitive: 'primReturnAsFromContextThrough' error: errorCode module: 'IA32ABI'>. + If of the second form answer false if this is not the most recent callback, and signal aSemaphore + if it is, so as to implement LIFO ordering of callbacks." - <primitive: 'primReturnAsFromContextThrough' error: errorCode module: 'IA32ABI'>" <export: true> + | vmCallbackContext isMostRecent | + <var: #vmCallbackContext type: #'VMCallbackContext *'> + interpreterProxy methodArgumentCount = 3 + ifTrue: + [vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 3)) + to: #'VMCallbackContext *'. + isMostRecent := vmCallbackContext = self getMostRecentCallbackContext. + isMostRecent ifFalse: + [^interpreterProxy methodReturnValue: interpreterProxy falseObject]. + (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + [interpreterProxy signalNoResume: (interpreterProxy stackValue: 2)] whileFalse] + ifFalse: + [vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 2)) + to: #'VMCallbackContext *']. (interpreterProxy returnAs: (interpreterProxy stackValue: 1) + ThroughCallback: vmCallbackContext - ThroughCallback: (self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 2)) - to: #'VMCallbackContext *') Context: (interpreterProxy stackValue: 0)) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. "NOTREACHED"! Item was changed: ----- Method: IA32ABIPlugin>>primReturnFromContextThrough (in category 'primitives-callbacks') ----- primReturnFromContextThrough "Return a result from a callback to the callback's callee. The primitive + has a signature of either of the forms: + result <FFICallbackResult> primReturnFromContext: callbackContext <MethodContext> through: jmpBuf <Integer> + result <FFICallbackResult> primSignal: aSemaphore <Semaphore> andReturnFromContext: callbackContext <MethodContext> through: jmpBuf <Integer> + <primitive: 'primReturnFromContextThrough' error: errorCode module: 'IA32ABI'>. + If of the second form answer true if this is not the most recent callback, and signal aSemaphore + if it is, so as to implement LIFO ordering of callbacks." - has a signature of the form: - result <FFICallbackResult> primReturnFromContext: callbackContext <Context> through: jmpBuf <Integer> - <primitive: 'primReturnFromContextThrough' error: errorCode module: 'IA32ABI'>" <export: true> <legacy> | mac vmCallbackContext vmCallbackReturnValue isMostRecent | <var: #vmCallbackContext type: #'VMCallbackContext *'> <var: #vmCallbackReturnValue type: #'VMCallbackReturnValue *'> vmCallbackContext := self cCoerceSimple: (interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0)) to: #'VMCallbackContext *'. (interpreterProxy failed or: [vmCallbackContext = 0]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (mac := interpreterProxy methodArgumentCount) = 3 ifTrue: [isMostRecent := vmCallbackContext = self getMostRecentCallbackContext. isMostRecent ifFalse: [interpreterProxy methodReturnValue: interpreterProxy trueObject. ^nil]. + (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore - (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) == interpreterProxy classSemaphore ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. [interpreterProxy signalNoResume: (interpreterProxy stackValue: 2)] whileFalse]. vmCallbackReturnValue := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: mac)) to: #'VMCallbackReturnValue *'.. self cCode: "C needs a typedef for structs to be assigned, but that implies a struct class for just one assignment." [self mem: (self addressOf: vmCallbackContext rvs) cp: (self addressOf: vmCallbackReturnValue crvrvs) y: (self sizeof: vmCallbackContext rvs)] inSmalltalk: [vmCallbackContext rvs: vmCallbackReturnValue crvrvs]. (interpreterProxy returnAs: (interpreterProxy integerObjectOf: vmCallbackReturnValue type + 1) ThroughCallback: vmCallbackContext Context: (interpreterProxy stackValue: 1)) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. "NOTREACHED"! Item was changed: ----- Method: InterpreterPlugin class>>pluginClassesUpTo: (in category 'translation') ----- pluginClassesUpTo: aPluginClass "Answer the classes to include for translation of aPluginClass, superclasses first, aPluginClass last." | theClass classes | classes := OrderedCollection new. theClass := self. [theClass == Object + or: [theClass == VMClass]] whileFalse: - or: [theClass == InterpreterSimulationObject - or: [theClass == VMClass]]] whileFalse: [classes addLast: theClass. theClass := theClass superclass]. ^classes reverse! Item was added: + ----- Method: InterpreterPrimitives>>primitivePathToUsing (in category 'other primitives') ----- + primitivePathToUsing + "primitivePathTo: anObject using: stack <Array> followWeak: boolean + Answer a path to anObject from the root that does not pass through + the current context" + | err path | + <export: true> + self externalWriteBackHeadFramePointers. + err := self pathTo: (self stackValue: 2) using: (self stackValue: 1) followWeak: self stackTop = objectMemory trueObject. + err ~= 0 ifTrue: + [^self primitiveFailFor: err]. + path := self self stackValue: 1. + self pop: argumentCount + 1 thenPush: path! Item was removed: - Object subclass: #InterpreterSimulationObject - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-Plugins'! Item was removed: - ----- Method: InterpreterSimulationObject>>cCoerce:to: (in category 'simulation') ----- - cCoerce: value to: cTypeString - "Here the Simulator has a chance to create properly typed flavors of CArray access." - - value isCObjectAccessor ifTrue: - [^ self getInterpreter cCoerce: value to: cTypeString]. - (value isMemberOf: CArray) ifTrue: - [^ self getInterpreter cCoerce: value to: cTypeString]. - ^ value! Item was removed: - ----- Method: InterpreterSimulationObject>>long32At: (in category 'memory access') ----- - long32At: byteAddress - "Simulation support. Answer the 32-bit word at byteAddress which must be 0 mod 4." - - ^self getInterpreter long32At: byteAddress! Item was removed: - ----- Method: InterpreterSimulationObject>>long32At:put: (in category 'memory access') ----- - long32At: byteAddress put: a32BitValue - "Simulation support. Store the 32-bit value at byteAddress which must be 0 mod 4." - - ^self getInterpreter long32At: byteAddress put: a32BitValue! Item was removed: - ----- Method: InterpreterSimulationObject>>oopForPointer: (in category 'memory access') ----- - oopForPointer: aPointer - "Simulation support. Pointers and oops are the same when simulating; answer aPointer." - - ^aPointer! Item was removed: - ----- Method: InterpreterSimulationObject>>pointerForOop: (in category 'memory access') ----- - pointerForOop: anOop - "Simulation support. Pointers and oops are the same when simulating; answer anOop." - - ^anOop! Item was changed: ----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') ----- asTranslatorNodeIn: aTMethod "make a CCodeGenerator equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used." | rcvrOrNil sel args | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: [^aTMethod superExpansionNodeFor: selector key args: arguments]. sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key]. ((sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." + or: [sel = #cCode:]) + and: [arguments first isBlockNode]) ifTrue: - or: [sel = #cCode:]) - and: [arguments first isBlockNode]) ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. args := (1 to: sel numArgs) collect: [:i | (arguments at: i) asTranslatorNodeIn: aTMethod]. + (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: + ["Restore limit expr that got moved by transformToDo:" + args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. + args second. + args third. "add the limit var as a hidden extra argument; we may need it later" + TVariableNode new setName: arguments first key}]. + ((sel = #ifFalse: or: [sel = #or:]) + and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: + ["Restore argument block that got moved by transformOr: or transformIfFalse:" + args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. - (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) - ifTrue: ["Restore limit expr that got moved by transformToDo:" - args at: 1 put: ((arguments at: 7) value asTranslatorNodeIn: aTMethod)]. - (sel = #or: and: [arguments size = 2 and: [(arguments at: 2) notNil]]) - ifTrue: ["Restore argument block that got moved by transformOr:" - args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. - (sel = #ifFalse: and: [arguments size = 2 and: [(arguments at: 2) notNil]]) - ifTrue: ["Restore argument block that got moved by transformIfFalse:" - args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. ^TSendNode new setSelector: sel receiver: rcvrOrNil arguments: args! Item was changed: ----- Method: NewCoObjectMemory>>restoreHeaderOf:to: (in category 'become') ----- restoreHeaderOf: obj to: objHeader super restoreHeaderOf: obj to: objHeader. (self isCompiledMethodHeader: objHeader) ifTrue: [(self asserta: ((coInterpreter methodHasCogMethod: obj) not + or: [obj = (coInterpreter cogMethodOf: obj) methodObject])) ifFalse: - or: [obj = (coInterpreter cogMethodOf: obj)])) ifFalse: [self error: 'attempt to become cogged method']]! Item was added: + ----- Method: NewObjectMemory>>allObjectsDo: (in category 'debug support') ----- + allObjectsDo: aBlock + <doNotGenerate> + | oop | + oop := self firstObject. + [oop < freeStart] whileTrue: + [(self isFreeObject: oop) ifFalse: + [aBlock value: oop]. + oop := self objectAfterWhileForwarding: oop]! Item was changed: ----- Method: NewObjectMemory>>become:with:twoWay:copyHash: (in category 'become') ----- become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag "All references to each object in array1 are swapped with all references to the corresponding object in array2. That is, all pointers to one object are replaced with with pointers to the other. The arguments must be arrays of the same length. Returns PrimNoErr if the primitive succeeds." "Implementation: Uses forwarding blocks to update references as done in compaction." | start | self leakCheckBecome ifTrue: [self runLeakCheckerForFullGC: true]. (self isArray: array1) ifFalse: [^PrimErrBadReceiver]. ((self isArray: array2) and: [(self lastPointerOf: array1) = (self lastPointerOf: array2)]) ifFalse: [^PrimErrBadArgument]. (twoWayFlag or: [copyHashFlag]) ifTrue: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]] ifFalse: [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate]]. (self prepareForwardingTableForBecoming: array1 with: array2 twoWay: twoWayFlag) ifFalse: [^PrimErrNoMemory]. "fail; not enough space for forwarding table" (self allYoung: array1 and: array2) ifTrue: [start := youngStart"sweep only the young objects plus the roots"] ifFalse: [start := self startOfMemory"sweep all objects"]. coInterpreter preBecomeAction. self mapPointersInObjectsFrom: start to: freeStart. twoWayFlag ifTrue: [self restoreHeadersAfterBecoming: array1 with: array2] ifFalse: [self restoreHeadersAfterForwardBecome: copyHashFlag]. coInterpreter postBecomeAction. self initializeMemoryFirstFree: freeStart. "re-initialize memory used for forwarding table" self leakCheckBecome ifTrue: [self runLeakCheckerForFullGC: true]. - self forceInterruptCheck. "pretty much guaranteed to take a long time, so check for timers etc ASAP" ^PrimNoErr "success"! Item was added: + ----- Method: NewObjectMemory>>mark: (in category 'primitive support') ----- + mark: obj + <inline: true> + self baseHeader: obj put: ((self baseHeader: obj) bitOr: MarkBit)! Item was added: + ----- Method: NewObjectMemory>>nilFieldsOf: (in category 'primitive support') ----- + nilFieldsOf: arrayObj + 0 to: (self lengthOf: arrayObj) - 1 do: + [:i| + self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]! Item was added: + ----- Method: NewObjectMemory>>unmarkAllObjects (in category 'primitive support') ----- + unmarkAllObjects + | oop hdr | + oop := self firstObject. + [oop < freeStart] whileTrue: + [(self isFreeObject: oop) ifFalse: + [hdr := self baseHeader: oop. + (hdr bitAnd: MarkBit) ~= 0 ifTrue: + [self baseHeader: oop put: (hdr bitAnd: AllButMarkBit)]]. + oop := self objectAfter: oop]! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primInLibraryFindSymbol (in category 'primitives-library loading') ----- primInLibraryFindSymbol "Attempt to find the address of a symbol in a loaded library. The primitive can have a signature either of the form: <Anywhere> primInLibrary: libraryHandle <Alien> findSymbol: symbolName <String> ^<Integer> <primitive: 'primInLibraryFindSymbol' error: errorCode module: 'IA32ABI'> or: libraryHandle <Alien> primFindSymbol: symbolName <String> ^<Integer> <primitive: 'primInLibraryFindSymbol' error: errorCode module: 'IA32ABI'>" - | functionName libraryProxy address | <export: true> + | functionName libraryProxy address | + <var: #address type: #'void *'> functionName := interpreterProxy stackValue: 0. libraryProxy := interpreterProxy stackValue: 1. ((self isAlien: libraryProxy) and: [(interpreterProxy byteSizeOf: libraryProxy) >= 2 * BytesPerOop and: [interpreterProxy isBytes: functionName]]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. address := interpreterProxy ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: functionName) + to: #sqInt) - to: 'sqInt') OfLength: (interpreterProxy byteSizeOf: functionName) FromModule: (self longAt: libraryProxy + BaseHeaderSize + BytesPerOop). (interpreterProxy failed or: [address = 0]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNotFound]. + interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: address asUnsignedInteger)! - interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: address)! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primLoadLibrary (in category 'primitives-library loading') ----- primLoadLibrary "Attempt to load a library of the given name. The primitive will have a signature of the form: <Anywhere> primLoadLibrary: libraryName <String> ^<Integer> <primitive: 'primLoadLibrary' error: errorCode module: 'IA32ABI'>" - | libraryName libraryHandle | <export: true> + | libraryName libraryHandle | + <var: #libraryHandle type: #'void *'> libraryName := interpreterProxy stackValue: 0. (interpreterProxy isBytes: libraryName) ifFalse: [^ interpreterProxy primitiveFailFor: PrimErrBadArgument]. libraryHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: libraryName) to: 'sqInt') OfLength: (interpreterProxy byteSizeOf: libraryName). libraryHandle = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNotFound]. + interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: libraryHandle asUnsignedInteger)! - interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: libraryHandle)! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primReturnAsFromContextThrough (in category 'primitives-callbacks') ----- primReturnAsFromContextThrough "Return a result from a callback to the callback's callee. The primitive + has a signature of either of the forms: - has a signature of the form: result <VMCallbackContext32/64> primReturnAs: returnTypeCode <Integer> FromContext: callbackContext <Context> + result <VMCallbackContext32/64> + primSignal: aSemaphore <Semaphore> + andReturnAs: returnTypeCode <Integer> + FromContext: callbackContext <Context> + <primitive: 'primReturnAsFromContextThrough' error: errorCode module: 'IA32ABI'>. + If of the second form answer false if this is not the most recent callback, and signal aSemaphore + if it is, so as to implement LIFO ordering of callbacks." - <primitive: 'primReturnAsFromContextThrough' error: errorCode module: 'IA32ABI'>" <export: true> + | vmCallbackContext isMostRecent | + <var: #vmCallbackContext type: #'VMCallbackContext *'> + interpreterProxy methodArgumentCount = 3 + ifTrue: + [vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 3)) + to: #'VMCallbackContext *'. + isMostRecent := vmCallbackContext = self getMostRecentCallbackContext. + isMostRecent ifFalse: + [^interpreterProxy methodReturnValue: interpreterProxy falseObject]. + (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + [interpreterProxy signalNoResume: (interpreterProxy stackValue: 2)] whileFalse] + ifFalse: + [vmCallbackContext := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 2)) + to: #'VMCallbackContext *']. (interpreterProxy returnAs: (interpreterProxy stackValue: 1) + ThroughCallback: vmCallbackContext - ThroughCallback: (self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: 2)) - to: #'VMCallbackContext *') Context: (interpreterProxy stackValue: 0)) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. "NOTREACHED"! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primReturnFromContextThrough (in category 'primitives-callbacks') ----- primReturnFromContextThrough "Return a result from a callback to the callback's callee. The primitive + has a signature of either of the forms: + result <FFICallbackResult> primReturnFromContext: callbackContext <MethodContext> through: jmpBuf <Integer> + result <FFICallbackResult> primSignal: aSemaphore <Semaphore> andReturnFromContext: callbackContext <MethodContext> through: jmpBuf <Integer> + <primitive: 'primReturnFromContextThrough' error: errorCode module: 'IA32ABI'>. + If of the second form answer true if this is not the most recent callback, and signal aSemaphore + if it is, so as to implement LIFO ordering of callbacks." - has a signature of the form: - result <FFICallbackResult> primReturnFromContext: callbackContext <Context> through: jmpBuf <Integer> - <primitive: 'primReturnFromContextThrough' error: errorCode module: 'IA32ABI'>" <export: true> <legacy> | mac vmCallbackContext vmCallbackReturnValue isMostRecent | <var: #vmCallbackContext type: #'VMCallbackContext *'> <var: #vmCallbackReturnValue type: #'VMCallbackReturnValue *'> vmCallbackContext := self cCoerceSimple: (interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0)) to: #'VMCallbackContext *'. (interpreterProxy failed or: [vmCallbackContext = 0]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (mac := interpreterProxy methodArgumentCount) = 3 ifTrue: [isMostRecent := vmCallbackContext = self getMostRecentCallbackContext. isMostRecent ifFalse: [interpreterProxy methodReturnValue: interpreterProxy trueObject. ^nil]. + (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore - (interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) == interpreterProxy classSemaphore ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. [interpreterProxy signalNoResume: (interpreterProxy stackValue: 2)] whileFalse]. vmCallbackReturnValue := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: mac)) to: #'VMCallbackReturnValue *'.. self cCode: "C needs a typedef for structs to be assigned, but that implies a struct class for just one assignment." [self mem: (self addressOf: vmCallbackContext rvs) cp: (self addressOf: vmCallbackReturnValue crvrvs) y: (self sizeof: vmCallbackContext rvs)] inSmalltalk: [vmCallbackContext rvs: vmCallbackReturnValue crvrvs]. (interpreterProxy returnAs: (interpreterProxy integerObjectOf: vmCallbackReturnValue type + 1) ThroughCallback: vmCallbackContext Context: (interpreterProxy stackValue: 1)) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. "NOTREACHED"! Item was added: + ----- Method: RiscOSVMMaker class>>forPlatform: (in category 'initialisation') ----- + forPlatform: ignored + "override to keep a RiscOSVMMaker in charge instead of a CrossPlatformVMMaker" + ^self new initialize setPlatName: self name! Item was added: + ----- Method: RiscOSVMMaker class>>generateSqueakStackVM (in category 'configurations') ----- + generateSqueakStackVM + "RISC OS version; build needed plugins, make sure filename tweaking is used" + "RiscOSVMMaker generateSqueakStackVM" + ^self + generate: StackInterpreter + to: (FileDirectory default directoryNamed: 'stacksrc') fullName + platformDir: (FileDirectory default directoryNamed: 'platforms') fullName + excluding: #(AsynchFilePlugin BrokenPlugin CroquetPlugin FFIPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JoystickTabletPlugin MIDIPlugin MacMenubarPlugin Mpeg3Plugin NewsqueakIA32ABIPlugin QuicktimePlugin SerialPlugin TestOSAPlugin ThreadedARMFFIPlugin ThreadedFFIPlugin ThreadedIA32FFIPlugin ThreadedPPCBEFFIPlugin UUIDPlugin VMProfileMacSupportPlugin)! Item was added: + ----- Method: RiscOSVMMaker>>gnuifyInterpreterFile (in category 'processing external files') ----- + gnuifyInterpreterFile + "do nothing here"! Item was changed: ----- Method: RiscOSVMMaker>>sourceFilePathFor: (in category 'generate sources') ----- + sourceFilePathFor: sourceFileName - sourceFilePathFor: class "return the full path for the interpreter file" "RiscOS keeps the interp file in a 'c' subdirectory of coreVMDirectory" self coreVMDirectory assureExistenceOfPath: 'c'. + ^(self coreVMDirectory directoryNamed: 'c') fullNameFor: (sourceFileName allButLast: 2)! - ^(self coreVMDirectory directoryNamed: 'c') fullNameFor: class sourceFileName! Item was added: + ----- Method: SimpleStackBasedCogit class>>callingConvention (in category 'documentation') ----- + callingConvention + "The Smalltalk-to-Smalltalk calling convention for SimpleStackBasedCogit is + designed to be congruent with the interpreter and convenient for inline cacheing. + For inline cacheing it is convenient if the receiver is in a register. + + Hence the calling convention is: + + On call ReceiverResultReg (edx on x86) contains the receiver, and the receiver + and arguments are all on the stack, receiver furthest from top-of-stack. + + If the number of arguments is 3 or greater then the argument count is passed in + SendNumArgsReg (this is for the linking run-time routine; it is ignored in linked sends). + + On return result is in ReceiverResultReg. The callee removes arguments from the stack. + The caller pushes the result if the result is used."! Item was changed: ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForNewspeakV3PlusClosures (in category 'class initialization') ----- initializeBytecodeTableForNewspeakV3PlusClosures "SimpleStackBasedCogit initializeBytecodeTableForNewspeakV3PlusClosures" + NSSendIsPCAnnotated := true. "IsNSSendCall used by PushImplicitReceiver" self flag: 'Special selector send class must be inlined to agree with the interpreter, which inlines class. If class is sent to e.g. a general instance of ProtoObject then unless class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit have identical semantics. We get away with not hardwiring the other special selectors either because in the Cointerpreter they are not inlined or because they are inlined only to instances of classes for which there will always be a method.'. self generatorTableFrom: #( (1 0 15 genPushReceiverVariableBytecode) (1 16 31 genPushTemporaryVariableBytecode) (1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1) (1 64 95 genPushLiteralVariableBytecode needsFrameNever: 1) (1 96 103 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability" (1 104 111 genStoreAndPopTemporaryVariableBytecode) (1 112 112 genPushReceiverBytecode) (1 113 113 genPushConstantTrueBytecode needsFrameNever: 1) (1 114 114 genPushConstantFalseBytecode needsFrameNever: 1) (1 115 115 genPushConstantNilBytecode needsFrameNever: 1) (1 116 119 genPushQuickIntegerConstantBytecode needsFrameNever: 1) "method returns in blocks need a frame because of nonlocalReturn:through:" (1 120 120 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0) (1 121 121 genReturnTrue return needsFrameIfInBlock: isMappedInBlock 0) (1 122 122 genReturnFalse return needsFrameIfInBlock: isMappedInBlock 0) (1 123 123 genReturnNil return needsFrameIfInBlock: isMappedInBlock 0) (1 124 124 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1) (1 125 125 genReturnTopFromBlock return needsFrameNever: -1) (3 126 126 genDynamicSuperSendBytecode isMapped) "Newspeak" (2 127 127 genPushImplicitReceiverBytecode isMapped) "Newspeak" (2 128 128 extendedPushBytecode needsFrameNever: 1) (2 129 129 extendedStoreBytecode) (2 130 130 extendedStoreAndPopBytecode) (2 131 131 genExtendedSendBytecode isMapped) (3 132 132 doubleExtendedDoAnythingBytecode isMapped) (2 133 133 genExtendedSuperBytecode isMapped) (2 134 134 genSecondExtendedSendBytecode isMapped) (1 135 135 genPopStackBytecode needsFrameNever: -1) (1 136 136 duplicateTopBytecode needsFrameNever: 1) (1 137 137 genPushActiveContextBytecode) (2 138 138 genPushNewArrayBytecode) (2 139 139 genPushExplicitOuterSendReceiverBytecode isMapped) "Newspeak" (3 140 140 genPushRemoteTempLongBytecode) (3 141 141 genStoreRemoteTempLongBytecode) (3 142 142 genStoreAndPopRemoteTempLongBytecode) (4 143 143 genPushClosureCopyCopiedValuesBytecode block v3:Block:Code:Size:) (1 144 151 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:) (1 152 159 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v3:ShortForward:Branch:Distance:) (2 160 163 genLongUnconditionalBackwardJump branch isMapped "because of interrupt check" v3:Long:Branch:Distance:) (2 164 167 genLongUnconditionalForwardJump branch v3:Long:Branch:Distance:) (2 168 171 genLongJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v3:LongForward:Branch:Distance:) (2 172 175 genLongJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v3:LongForward:Branch:Distance:) (1 176 197 genSpecialSelectorSend isMapped) (1 198 198 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)" (1 199 199 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)" (1 200 207 genSpecialSelectorSend isMapped) (1 208 223 genSendLiteralSelector0ArgsBytecode isMapped) (1 224 239 genSendLiteralSelector1ArgBytecode isMapped) (1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))! Item was changed: ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') ----- initializeBytecodeTableForNewspeakV4 "SimpleStackBasedCogit initializeBytecodeTableForNewspeakV4" + NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit" self flag: 'Special selector send class must be inlined to agree with the interpreter, which inlines class. If class is sent to e.g. a general instance of ProtoObject then unless class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit have identical semantics. We get away with not hardwiring the other special selectors either because in the Cointerpreter they are not inlined or because they are inlined only to instances of classes for which there will always be a method.'. self generatorTableFrom: #( "1 byte bytecodes" (1 0 15 genPushReceiverVariableBytecode) (1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1) (1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1) (1 64 75 genPushTemporaryVariableBytecode) (1 76 76 genPushReceiverBytecode) (1 77 77 genExtPushPseudoVariableOrOuterBytecode) (1 78 78 genPushConstantZeroBytecode) (1 79 79 genPushConstantOneBytecode) (1 80 101 genSpecialSelectorSend isMapped) "#+ #- #< #> #<= #>= #= #~= #at: #at:put: #size #next #nextPut: #atEnd" (1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)" (1 103 103 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)" (1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y" (1 112 127 genSendLiteralSelector0ArgsBytecode isMapped) (1 128 143 genSendLiteralSelector1ArgBytecode isMapped) (1 144 159 genSendLiteralSelector2ArgsBytecode isMapped) (1 160 175 genSendAbsentImplicit0ArgsBytecode isMapped) (1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability" (1 184 191 genStoreAndPopTemporaryVariableBytecode) (1 192 199 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:) (1 200 207 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v3:ShortForward:Branch:Distance:) (1 208 215 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v3:ShortForward:Branch:Distance:) (1 216 216 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0) (1 217 217 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1) (1 218 218 genExtReturnTopFromBlock return needsFrameNever: -1) (1 219 219 duplicateTopBytecode needsFrameNever: 1) (1 220 220 genPopStackBytecode needsFrameNever: -1) (1 221 221 genExtNopBytecode needsFrameNever: 0) (1 222 223 unknownBytecode) "2 byte bytecodes" (2 224 224 extABytecode extension) (2 225 225 extBBytecode extension) (2 226 226 genExtPushReceiverVariableBytecode) (2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1) (2 228 228 genExtPushLiteralBytecode needsFrameNever: 1) (2 229 229 genExtPushIntegerBytecode needsFrameNever: 1) (2 230 230 genLongPushTemporaryVariableBytecode) (2 231 231 genPushNewArrayBytecode) (2 232 232 genExtStoreReceiverVariableBytecode) (2 233 233 genExtStoreLiteralVariableBytecode) (2 234 234 genLongStoreTemporaryVariableBytecode) (2 235 235 genExtStoreAndPopReceiverVariableBytecode) (2 236 236 genExtStoreAndPopLiteralVariableBytecode) (2 237 237 genLongStoreAndPopTemporaryVariableBytecode) (2 238 238 genExtSendBytecode isMapped) (2 239 239 genExtSendSuperBytecode isMapped) (2 240 240 genExtSendAbsentImplicitBytecode isMapped) (2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped) (2 242 242 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:) (2 243 243 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:) (2 244 244 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:) (2 245 248 unknownBytecode) "3 byte bytecodes" (3 249 249 callPrimitiveBytecode) (3 250 250 genPushRemoteTempLongBytecode) (3 251 251 genStoreRemoteTempLongBytecode) (3 252 252 genStoreAndPopRemoteTempLongBytecode) (3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:) (3 254 255 unknownBytecode))! Item was removed: - ----- Method: SimpleStackBasedCogit>>genGetImplicitReceiverFor: (in category 'bytecode generators') ----- - genGetImplicitReceiverFor: selector - "Cached implicit receiver implementation. Caller looks like - mov selector, ClassReg - call cePushImplicitReceiver - br continue - Lclass .word - Lmixin: .word - continue: - If class matches class of receiver then mixin contains either 0 or the implicit receiver. - If 0, answer the actual receiver. This is done in the trampoline. - See generateNewspeakRuntime." - | skip | - <var: #skip type: #'AbstractInstruction *'> - (objectMemory isYoung: selector) ifTrue: - [hasYoungReferent := true]. - self assert: needsFrame. - self MoveCw: selector R: SendNumArgsReg. - self CallNewspeakSend: ceImplicitReceiverTrampoline. - skip := self Jump: 0. - self Fill32: 0. - self Fill32: 0. - skip jmpTarget: self Label. - ^0! Item was added: + ----- Method: SimpleStackBasedCogit>>genGetImplicitReceiverFor:forPush: (in category 'bytecode generators') ----- + genGetImplicitReceiverFor: selector forPush: forPushSendBar + "Cached implicit receiver implementation. Caller looks like + mov selector, ClassReg + call ceImplicitReceiverTrampoline + br continue + Lclass .word + Lmixin: .word + continue: + If class matches class of receiver then mixin contains either 0 or the implicit receiver. + If 0, answer the actual receiver. This is done in the trampoline. + See generateNewspeakRuntime." + + | skip | + <var: #skip type: #'AbstractInstruction *'> + "N.B. For PC mapping either this is used for SendAbsentImplicit or for PushAbsentReceiver + but not both. So any Newspeak instruction set has to choose either SendAbsentImplicit + or PushImplicitReceiver. See isPCMappedAnnotation:alternateInstructionSet:" + self assert: forPushSendBar = (self isPCMappedAnnotation: IsNSSendCall + alternateInstructionSet: bytecodeSetOffset > 0). + (objectMemory isYoung: selector) ifTrue: + [hasYoungReferent := true]. + self assert: needsFrame. + self MoveCw: selector R: SendNumArgsReg. + self CallNewspeakSend: ceImplicitReceiverTrampoline. + skip := self Jump: 0. + self Fill32: 0. + self Fill32: 0. + skip jmpTarget: self Label. + ^0! Item was changed: ----- Method: SimpleStackBasedCogit>>genPushImplicitReceiverBytecode (in category 'bytecode generators') ----- genPushImplicitReceiverBytecode | result | + result := self genGetImplicitReceiverFor: (self getLiteral: byte1) forPush: true. - result := self genGetImplicitReceiverFor: (self getLiteral: byte1). result ~= 0 ifTrue: [^result]. self PushR: ReceiverResultReg. ^0! Item was changed: ----- Method: SimpleStackBasedCogit>>genSendAbsentImplicit:numArgs: (in category 'bytecode generators') ----- genSendAbsentImplicit: selector numArgs: numArgs "Get the implicit receiver and shuffle arguments if necessary. Then send." <inline: false> | result | + result := self genGetImplicitReceiverFor: selector forPush: false. - result := self genGetImplicitReceiverFor: selector. result ~= 0 ifTrue: [^result]. numArgs = 0 ifTrue: [self PushR: ReceiverResultReg] ifFalse: [self MoveMw: 0 r: SPReg R: TempReg. self PushR: TempReg. 2 to: numArgs do: [:index| self MoveMw: index * BytesPerWord r: SPReg R: TempReg. self MoveR: TempReg Mw: index - 1 * BytesPerWord r: SPReg]. "if we copied the code in genSend:numArgs: we could save an instruction. But we care not; the smarts are in StackToRegisterMappingCogit et al" self MoveR: ReceiverResultReg Mw: numArgs * BytesPerWord r: SPReg]. ^self genSend: selector numArgs: numArgs! Item was changed: ----- Method: SistaStackToRegisterMappingCogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') ----- mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg "Machine-code <-> bytecode pc mapping support. Evaluate functionSymbol for each mcpc, bcpc pair in the map until the function returns non-zero, answering that result, or 0 if it fails to. This works only for frameful methods. Override to add the descriptor as the first argument to function." <var: #cogMethod type: #'CogBlockMethod *'> <var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor * desc, char *mcpc, sqInt bcpc, void *arg)'> <var: #arg type: #'void *'> | isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result latestContinuation byte descriptor bsOffset nExts | <var: #descriptor type: #'BytecodeDescriptor *'> <var: #homeMethod type: #'CogMethod *'> self assert: cogMethod stackCheckOffset > 0. "In both CMMethod and CMBlock cases find the start of the map and skip forward to the bytecode pc map entry for the stack check." cogMethod cmType = CMMethod ifTrue: [isInBlock := false. homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'. self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader). map := self mapStartFor: homeMethod. self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]). latestContinuation := startbcpc. aMethodObj := homeMethod methodObject. endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1. bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader] ifFalse: [isInBlock := true. homeMethod := cogMethod cmHomeMethod. map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod) inMethod: homeMethod. self assert: map ~= 0. self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial" or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]). [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue: [map := map - 1]. map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header." aMethodObj := homeMethod methodObject. bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader). bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader. byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset. descriptor := self generatorAt: byte. endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj]. bcpc := startbcpc. mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset. nExts := 0. "as a hack for collecting counters, remember the prev mcpc in a static variable." prevMapAbsPCMcpc := 0. "The stack check maps to the start of the first bytecode, the first bytecode being effectively after frame build." result := self perform: functionSymbol with: nil with: (self cCoerceSimple: mcpc to: #'char *') with: startbcpc with: arg. result ~= 0 ifTrue: [^result]. "Now skip up through the bytecode pc map entry for the stack check." [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue: [map := map - 1]. map := map - 1. [(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc" [mapByte >= FirstAnnotation ifTrue: [| annotation nextBcpc | annotation := mapByte >> AnnotationShift. mcpc := mcpc + (mapByte bitAnd: DisplacementMask). + (self isPCMappedAnnotation: annotation alternateInstructionSet: bsOffset > 0) ifTrue: - (self isPCMappedAnnotation: annotation) ifTrue: [[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset. descriptor := self generatorAt: byte. isInBlock ifTrue: [bcpc >= endbcpc ifTrue: [^0]] ifFalse: + [(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0]. - [(descriptor isReturn and: [bcpc > latestContinuation]) ifTrue: [^0]. (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue: [| targetPC | targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj. latestContinuation := latestContinuation max: targetPC]]. nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj. descriptor isMapped or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse: [bcpc := nextBcpc. nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]. "All subsequent bytecodes except backward branches map to the following bytecode. Backward branches map to themselves other- wise mapping could cause premature breaking out of loops." result := self perform: functionSymbol with: descriptor with: (self cCoerceSimple: mcpc to: #'char *') with: ((self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj) ifTrue: [bcpc] ifFalse: [bcpc + descriptor numBytes]) with: arg. result ~= 0 ifTrue: [^result]. bcpc := nextBcpc]. annotation = IsAbsPCReference ifTrue: [prevMapAbsPCMcpc := mcpc]] ifFalse: [mcpc := mcpc + (mapByte >= DisplacementX2N ifTrue: [mapByte - DisplacementX2N << AnnotationShift] ifFalse: [mapByte])]. map := map - 1]. ^0! Item was removed: - ----- Method: SmartSyntaxPluginTMethod>>oopVariable: (in category 'private') ----- - oopVariable: aString - - (locals includes: aString) ifFalse: - [locals add: aString. - self declarationAt: aString put: 'sqInt ', aString]. - ^TVariableNode new setName: aString! Item was changed: ----- Method: SmartSyntaxPluginTMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initializing') ----- setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment "Initialize this method using the given information." selector := sel. definingClass := class. returnType := #sqInt. "assume return type is sqInt for now" args := argList asOrderedCollection collect: [:arg | arg key]. + locals := (localList collect: [:arg | arg key]) asSet. - locals := localList asOrderedCollection collect: [:arg | arg key]. declarations := Dictionary new. primitive := aNumber. properties := methodProperties. comment := aComment. parseTree := aBlockNode asTranslatorNodeIn: self. labels := OrderedCollection new. complete := false. "set to true when all possible inlining has been done" export := self extractExportDirective. static := self extractStaticDirective. canAsmLabel := self extractLabelDirective. self extractSharedCase. isPrimitive := false. "set to true only if you find a primtive direction." suppressingFailureGuards := self extractSuppressFailureGuardDirective. self recordDeclarations. self extractPrimitiveDirectives. ! Item was changed: ----- Method: SocketPlugin>>primitiveSocket:getOptions: (in category 'primitives') ----- primitiveSocket: socket getOptions: optionName | s optionNameStart optionNameSize returnedValue errorCode results | + <var: #s type: #SocketPtr> + <var: #optionNameStart type: #'char *'> - <var: #s type: 'SocketPtr'> - <var: #optionNameStart type: 'char *'> self primitive: 'primitiveSocketGetOptions' parameters: #(Oop Oop). s := self socketValueOf: socket. interpreterProxy success: (interpreterProxy isBytes: optionName). + optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: #'char *'. - optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'. optionNameSize := interpreterProxy slotSizeOf: optionName. interpreterProxy failed ifTrue: [^nil]. returnedValue := 0. errorCode := self sqSocketGetOptions: s + optionNameStart: optionNameStart + optionNameSize: optionNameSize + returnedValue: (self addressOf: returnedValue). - optionNameStart: optionNameStart - optionNameSize: optionNameSize - returnedValue: (self cCode: '&returnedValue'). + results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. + interpreterProxy storePointer: 0 ofObject: results withValue: errorCode asSmallIntegerObj. + interpreterProxy storePointer: 1 ofObject: results withValue: returnedValue asSmallIntegerObj. - interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj. - interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj. - interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2). - results := interpreterProxy popRemappableOop. - interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop. - interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop. ^ results! Item was changed: ----- Method: SocketPlugin>>primitiveSocket:receiveUDPDataBuf:start:count: (in category 'primitives') ----- primitiveSocket: socket receiveUDPDataBuf: array start: startIndex count: count + | s elementSize arrayBase bufStart bytesReceived results address port moreFlag | + <var: #s type: #SocketPtr> + <var: #arrayBase type: #'char *'> + <var: #bufStart type: #'char *'> - | s byteSize arrayBase bufStart bytesReceived results address port moreFlag | - <var: #s type: 'SocketPtr'> - <var: #arrayBase type: 'char *'> - <var: #bufStart type: 'char *'> self primitive: 'primitiveSocketReceiveUDPDataBufCount' + parameters: #(Oop Oop SmallInteger SmallInteger). - parameters: #(Oop Oop SmallInteger SmallInteger ). s := self socketValueOf: socket. "buffer can be any indexable words or bytes object" interpreterProxy success: (interpreterProxy isWordsOrBytes: array). (interpreterProxy isWords: array) + ifTrue: [elementSize := 4] + ifFalse: [elementSize := 1]. - ifTrue: [byteSize := 4] - ifFalse: [byteSize := 1]. interpreterProxy success: (startIndex >= 1 and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]). interpreterProxy failed ifFalse: ["Note: adjust bufStart for zero-origin indexing" + arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *'. + bufStart := arrayBase + (startIndex - 1 * elementSize). + address := 0. + port := 0. + moreFlag := 0. + bytesReceived := self sqSocket: s + ReceiveUDPDataBuf: bufStart + Count: count * elementSize + address: (self addressOf: address) + port: (self addressOf: port) + moreFlag: (self addressOf: moreFlag). + - arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'. - bufStart := arrayBase + (startIndex - 1 * byteSize). "allocate storage for results, remapping newly allocated oops in case GC happens during allocation" - address := 0. - port := 0. - moreFlag := 0. - bytesReceived := self - sqSocket: s - ReceiveUDPDataBuf: bufStart - Count: count * byteSize - address: (self cCode: '&address') - port: (self cCode: '&port') - moreFlag: (self cCode: '&moreFlag'). - - interpreterProxy pushRemappableOop: port asSmallIntegerObj. interpreterProxy pushRemappableOop: (self intToNetAddress: address). + results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 4. + interpreterProxy storePointer: 0 ofObject: results withValue: (bytesReceived // elementSize) asSmallIntegerObj. - interpreterProxy pushRemappableOop: (bytesReceived // byteSize) asSmallIntegerObj. - interpreterProxy pushRemappableOop: - (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 4). - results := interpreterProxy popRemappableOop. - interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop. interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop. + interpreterProxy storePointer: 2 ofObject: results withValue: port asSmallIntegerObj. + interpreterProxy storePointer: 3 ofObject: results withValue: (moreFlag + ifTrue: [interpreterProxy trueObject] + ifFalse: [interpreterProxy falseObject]). - interpreterProxy storePointer: 2 ofObject: results withValue: interpreterProxy popRemappableOop. - moreFlag - ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ] - ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ]. ]. ^ results! Item was changed: ----- Method: SocketPlugin>>primitiveSocket:setOptions:value: (in category 'primitives') ----- primitiveSocket: socket setOptions: optionName value: optionValue + "THIS BADLY NEEDS TO BE REWRITTEN TO TAKE Booleans AND Integers AS WELL AS (OR INSTEAD OF) Strings. + It is only used with booleans and integers and parsing these back out of strings in + sqSocketSetOptions:optionNameStart:optionNameSize:optionValueStart:optionValueSize:returnedValue: + is STUPID." - | s optionNameStart optionNameSize optionValueStart optionValueSize returnedValue errorCode results | + <var: #s type: #SocketPtr> + <var: #optionNameStart type: #'char *'> + <var: #optionValueStart type: #'char *'> - <var: #s type: 'SocketPtr'> - <var: #optionNameStart type: 'char *'> - <var: #optionValueStart type: 'char *'> self primitive: 'primitiveSocketSetOptions' parameters: #(Oop Oop Oop). s := self socketValueOf: socket. interpreterProxy success: (interpreterProxy isBytes: optionName). + optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: #'char *'. - optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'. optionNameSize := interpreterProxy slotSizeOf: optionName. interpreterProxy success: (interpreterProxy isBytes: optionValue). + optionValueStart:= self cCoerce: (interpreterProxy firstIndexableField: optionValue) to: #'char *'. - optionValueStart:= self cCoerce: (interpreterProxy firstIndexableField: optionValue) to: 'char *'. optionValueSize := interpreterProxy slotSizeOf: optionValue. interpreterProxy failed ifTrue: [^nil]. returnedValue := 0. errorCode := self sqSocketSetOptions: s + optionNameStart: optionNameStart + optionNameSize: optionNameSize + optionValueStart: optionValueStart + optionValueSize: optionValueSize + returnedValue: (self addressOf: returnedValue). - optionNameStart: optionNameStart - optionNameSize: optionNameSize - optionValueStart: optionValueStart - optionValueSize: optionValueSize - returnedValue: (self cCode: '&returnedValue'). + results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. + interpreterProxy storePointer: 0 ofObject: results withValue: errorCode asSmallIntegerObj. + interpreterProxy storePointer: 1 ofObject: results withValue: returnedValue asSmallIntegerObj. - interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj. - interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj. - interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2). - results := interpreterProxy popRemappableOop. - interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop. - interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop. ^ results! Item was changed: ----- Method: StackInterpreter class>>requiredMethodNames (in category 'translation') ----- requiredMethodNames "return the list of method names that should be retained for export or other support reasons" | requiredList | requiredList := self exportAPISelectors. requiredList addAll: NewObjectMemory requiredMethodNames. "A number of methods required by VM support code, jitter, specific platforms etc" requiredList addAll: #( assertValidExecutionPointe:r:s: characterForAscii: checkedLongAt: delayExpired + findClassOfMethod:forReceiver: findSelectorOfMethod: - findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending getSavedWindowSize getThisSessionID highBit: interpret loadInitialContext oopFromChunk: primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext: printExternalHeadFrame printFramesInPage: printFrame: printHeadFrame printMemory printOop: printStackPages printStackPageList printStackPagesInUse printStackPageListInUse readableFormat: readImageFromFile:HeapSize:StartingAt: setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain: setSavedWindowSize: success: validInstructionPointer:inMethod:framePointer:). "Nice to actually have all the primitives available" requiredList addAll: (self primitiveTable select: [:each| each isSymbol]). "InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those" InterpreterProxy organization categories do: [:cat | ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]]. ^requiredList! Item was added: + ----- Method: StackInterpreter>>addressCouldBeClassObj: (in category 'debug support') ----- + addressCouldBeClassObj: maybeClassObj + "Answer if maybeClassObj looks like a class object" + <inline: false> + ^(objectMemory addressCouldBeObj: maybeClassObj) + and: [((objectMemory isPointersNonInt: maybeClassObj) and: [(objectMemory lengthOf: maybeClassObj) >= 3]) + and: [(objectMemory isPointersNonInt: (objectMemory fetchPointer: SuperclassIndex ofObject: maybeClassObj)) + and: [(objectMemory isPointersNonInt: (objectMemory fetchPointer: MethodDictionaryIndex ofObject: maybeClassObj)) + and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: maybeClassObj))]]]]! Item was added: + ----- Method: StackInterpreter>>findClassContainingMethod:startingAt: (in category 'debug support') ----- + findClassContainingMethod: meth startingAt: classObj + | currClass classDict classDictSize methodArray i | + currClass := classObj. + [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. + classDictSize := objectMemory fetchWordLengthOf: classDict. + methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. + i := 0. + [i < (classDictSize - SelectorStart)] whileTrue: + [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: + [^currClass]. + i := i + 1]. + currClass := self superclassOf: currClass. + currClass = objectMemory nilObject] whileFalse. + ^currClass "method not found in superclass chain"! Item was changed: ----- Method: StackInterpreter>>findClassOfMethod:forReceiver: (in category 'debug support') ----- findClassOfMethod: meth forReceiver: rcvr + | rclass | + (objectMemory addressCouldBeOop: rcvr) ifTrue: + [rclass := objectMemory fetchClassOf: rcvr. + (self addressCouldBeClassObj: rclass) ifTrue: + [rclass := self findClassContainingMethod: meth startingAt: rclass. + rclass ~= objectMemory nilObject ifTrue: + [^rclass]]]. - - | rclass currClass classDict classDictSize methodArray i | (objectMemory addressCouldBeObj: meth) ifFalse: [^objectMemory nilObject]. + ^self findClassContainingMethod: meth startingAt: (self methodClassOf: meth)! - (objectMemory addressCouldBeOop: rcvr) - ifTrue: [rclass := objectMemory fetchClassOf: rcvr] - ifFalse: [rclass := self methodClassOf: meth]. - currClass := rclass. - [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. - classDictSize := objectMemory fetchWordLengthOf: classDict. - methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. - i := 0. - [i < (classDictSize - SelectorStart)] whileTrue: - [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: - [^currClass]. - i := i + 1]. - currClass := self superclassOf: currClass. - currClass = objectMemory nilObject] whileFalse. - ^rclass "method not found in superclass chain"! Item was added: + ----- Method: StackInterpreter>>findSelectorOfMethod: (in category 'debug support') ----- + findSelectorOfMethod: meth + | classObj classDict classDictSize methodArray i | + (objectMemory addressCouldBeObj: meth) ifFalse: + [^objectMemory nilObject]. + classObj := self methodClassOf: meth. + (self addressCouldBeClassObj: classObj) ifTrue: + [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: classObj. + classDictSize := objectMemory fetchWordLengthOf: classDict. + methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. + i := 0. + [i <= (classDictSize - SelectorStart)] whileTrue: + [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: + [^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)]. + i := i + 1]]. + ^objectMemory nilObject! Item was removed: - ----- Method: StackInterpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') ----- - findSelectorOfMethod: meth forReceiver: rcvr - - | currClass classDict classDictSize methodArray i | - (objectMemory addressCouldBeObj: meth) ifFalse: - [^objectMemory nilObject]. - (objectMemory addressCouldBeOop: rcvr) - ifTrue: [currClass := objectMemory fetchClassOf: rcvr] - ifFalse: [currClass := self methodClassOf: meth]. - [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. - classDictSize := objectMemory fetchWordLengthOf: classDict. - methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. - i := 0. - [i <= (classDictSize - SelectorStart)] whileTrue: - [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: - [^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)]. - i := i + 1]. - currClass := self superclassOf: currClass. - currClass = objectMemory nilObject] whileFalse. - ^currClass "method not found in superclass chain"! Item was changed: ----- Method: StackInterpreter>>printActivationNameFor:receiver:isBlock:firstTemporary: (in category 'debug printing') ----- printActivationNameFor: aMethod receiver: anObject isBlock: isBlock firstTemporary: maybeMessage + | methClass methodSel classObj | - | methClass methodSel | <inline: false> isBlock ifTrue: [self print: '[] in ']. methClass := self findClassOfMethod: aMethod forReceiver: anObject. + methodSel := self findSelectorOfMethod: aMethod. + ((objectMemory addressCouldBeOop: anObject) + and: [self addressCouldBeClassObj: (classObj := objectMemory fetchClassOf: anObject)]) - methodSel := self findSelectorOfMethod: aMethod forReceiver: anObject. - (objectMemory addressCouldBeOop: anObject) ifTrue: + [classObj = methClass - [(objectMemory fetchClassOf: anObject) = methClass ifTrue: [self printNameOfClass: methClass count: 5] ifFalse: + [self printNameOfClass: classObj count: 5. - [self printNameOfClass: (objectMemory fetchClassOf: anObject) count: 5. self print: '('. self printNameOfClass: methClass count: 5. self print: ')']] ifFalse: [self print: 'INVALID RECEIVER']. self print: '>'. (objectMemory addressCouldBeOop: methodSel) ifTrue: [methodSel = objectMemory nilObject ifTrue: [self print: '?'] ifFalse: [self printStringOf: methodSel]] ifFalse: [self print: 'INVALID SELECTOR']. (methodSel = (objectMemory splObj: SelectorDoesNotUnderstand) and: [(objectMemory addressCouldBeObj: maybeMessage) and: [(objectMemory fetchClassOf: maybeMessage) = (objectMemory splObj: ClassMessage)]]) ifTrue: ["print arg message selector" methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: maybeMessage. self print: ' '. self printStringOf: methodSel]! Item was changed: ----- Method: StackInterpreter>>selectorOfContext: (in category 'debug printing') ----- selectorOfContext: aContext (objectMemory isContext: aContext) ifFalse: [^nil]. + ^self findSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: aContext)! - ^self - findSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: aContext) - forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext)! Item was added: + ----- Method: StackInterpreterPrimitives>>field:ofFrame: (in category 'object access primitives') ----- + field: index ofFrame: theFP + "Arrange to answer naked frame pointers for unmarried + senders to avoid reifying contexts in the search." + <var: #theFP type: #'char *'> + <inline: false> + | callerFP | + <var: #callerFP type: #'char *'> + ^index caseOf: + {[SenderIndex] -> [callerFP := self frameCallerFP: theFP. + callerFP = 0 + ifTrue: [self frameCallerContext: theFP] + ifFalse: [(self frameHasContext: callerFP) + ifTrue: [self assert: (self checkIsStillMarriedContext: (self frameContext: callerFP) currentFP: nil). + self frameContext: callerFP] + ifFalse: [callerFP]]]. + [StackPointerIndex] -> [ConstZero]. + [InstructionPointerIndex] -> [ConstZero]. + [MethodIndex] -> [self frameMethodObject: theFP]. + [ClosureIndex] -> [(self frameIsBlockActivation: theFP) + ifTrue: [self frameStackedReceiver: theFP + numArgs: (self frameNumArgs: theFP)] + ifFalse: [objectMemory nilObject]]. + [ReceiverIndex] -> [self frameReceiver: theFP] } + otherwise: + [self assert: (index - CtxtTempFrameStart between: 0 and: (self stackPointerIndexForFrame: theFP)). + self temporary: index - CtxtTempFrameStart in: theFP]! Item was added: + ----- Method: StackInterpreterPrimitives>>fieldOrSenderFP:ofContext: (in category 'object access primitives') ----- + fieldOrSenderFP: index ofContext: contextObj + "Arrange to answer naked frame pointers for unmarried + senders to avoid reifying contexts in the search." + <inline: false> + | tempIndex spouseFP | + <var: #spouseFP type: #'char *'> + tempIndex := index - CtxtTempFrameStart. + (self isStillMarriedContext: contextObj) ifFalse: + [^tempIndex >= (self fetchStackPointerOf: contextObj) + ifTrue: [objectMemory nilObject] + ifFalse: [self fetchPointer: index ofObject: contextObj]]. + spouseFP := self frameOfMarriedContext: contextObj. + tempIndex >= (self stackPointerIndexForFrame: spouseFP) ifTrue: + [^objectMemory nilObject]. + ^self field: index ofFrame: spouseFP! Item was added: + ----- Method: StackInterpreterPrimitives>>fieldsInFrame: (in category 'object access primitives') ----- + fieldsInFrame: theFP + <var: #theFP type: #'char *'> + ^CtxtTempFrameStart + (self stackPointerIndexForFrame: theFP)! Item was added: + ----- Method: StackInterpreterPrimitives>>frameIsMarked: (in category 'object access primitives') ----- + frameIsMarked: theFPInt + ^((stackPages longAt: theFPInt + FoxFrameFlags) bitAnd: 2) ~= 0! Item was added: + ----- Method: StackInterpreterPrimitives>>isFrame:onPage: (in category 'object access primitives') ----- + isFrame: aFrame onPage: aPage + <var: #aFrame type: #'char *'> + <var: #aPage type: #'StackPage *'> + | theFP | + <var: #theFP type: #'char *'> + theFP := aPage headFP. + [theFP = aFrame ifTrue: [^true]. + theFP ~= aPage baseFP + and: [(stackPages stackPageFor: theFP) = aPage]] whileTrue: + [theFP := self frameCallerFP: theFP]. + ^false! Item was added: + ----- Method: StackInterpreterPrimitives>>markFrame: (in category 'object access primitives') ----- + markFrame: theFPInt + stackPages + longAt: theFPInt + FoxFrameFlags + put: ((stackPages longAt: theFPInt + FoxFrameFlags) bitOr: 2)! Item was added: + ----- Method: StackInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') ----- + pathTo: goal using: stack followWeak: followWeak + "Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found. + If found, unmark, leaving path in stack, and answer 0. Otherwise answer an error: + PrimErrBadArgument if stack is not an Array + PrimErrBadIndex if search overflows stack + PrimErrNotFound if goal cannot be found" + | current hdr index next stackSize stackp freeStartAtStart | + (objectMemory isArray: stack) ifFalse: + [^PrimErrBadArgument]. + freeStartAtStart := objectMemory freeStart. "check no allocations during search" + objectMemory beRootIfOld: stack. "so no store checks are necessary on stack" + stackSize := objectMemory lengthOf: stack. + objectMemory mark: stack. + "no need. the current context is not reachable from the active process (suspendedContext is nil)" + "objectMemory mark: self activeProcess." + current := objectMemory specialObjectsOop. + objectMemory mark: current. + index := objectMemory lengthOf: current. + stackp := 0. + [[(index := index - 1) >= -1] whileTrue: + [next := (stackPages couldBeFramePointer: current) + ifTrue: + [index >= 0 + ifTrue: [self field: index ofFrame: current] + ifFalse: [objectMemory nilObject]] + ifFalse: + [index >= 0 + ifTrue: + [hdr := objectMemory baseHeader: current. + (objectMemory isContextHeader: hdr) + ifTrue: [self fieldOrSenderFP: index ofContext: current] + ifFalse: [objectMemory fetchPointer: index ofObject: current]] + ifFalse: + [objectMemory fetchClassOfNonInt: current]]. + (stackPages couldBeFramePointer: next) + ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))] + ifFalse: [self assert: (self checkOkayOop: next)]. + next = goal ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory storePointer: stackp ofObject: stack withValue: current. + self pruneStack: stack stackp: stackp. + ^0]. + ((objectMemory isNonIntegerObject: next) + and: [(stackPages couldBeFramePointer: next) + ifTrue: [(self frameIsMarked: next) not] + ifFalse: + [(objectMemory isMarked: next) not + and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next]) + and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]]) + ifTrue: + [stackp + 2 > stackSize ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory nilFieldsOf: stack. + ^PrimErrBadIndex]. "PrimErrNoMemory ?" + objectMemory + storePointerUnchecked: stackp ofObject: stack withValue: current; + storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index). + stackp := stackp + 2. + (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *')) + ifTrue: + [self markFrame: next. + index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')] + ifFalse: + [hdr := objectMemory baseHeader: next. + objectMemory baseHeader: next put: (hdr bitOr: MarkBit). + (objectMemory isCompiledMethodHeader: hdr) + ifTrue: [index := self literalCountOf: next] + ifFalse: [index := objectMemory lengthOf: next]]. + current := next]]. + current = objectMemory specialObjectsOop ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory nilFieldsOf: stack. + ^PrimErrNotFound]. + index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack). + current := objectMemory fetchPointer: stackp - 2 ofObject: stack. + stackp := stackp - 2] repeat! Item was added: + ----- Method: StackInterpreterPrimitives>>pruneStack:stackp: (in category 'object access primitives') ----- + pruneStack: stack stackp: stackp + "Prune the stack to contain only the path, removing stacked indices + and mapping frame pointers to contexts The issue here is that a + GC can occur during ensureFrameIsMarried:SP:, but frame pointers + are not valid objects. So first prune back to objects and framePointers + as integers, and then replace frame pointers as integers by contexts." + + <inline: false> + | objOrFP theStack finger | + <var: #theFP type: #'char *'> + <var: #thePage type: #'StackPage *'> + <var: #theFPAbove type: #'char *'> + finger := 1. + 2 to: stackp - 1 by: 2 do: + [:i| + objOrFP := objectMemory fetchPointer: i ofObject: stack. + (stackPages couldBeFramePointer: (self cCoerceSimple: objOrFP to: #'char *')) ifTrue: + [objOrFP := self withSmallIntegerTags: objOrFP]. + objectMemory + storePointerUnchecked: finger + ofObject: stack + withValue: objOrFP. + finger := finger + 1]. + finger to: (objectMemory lengthOf: stack) - 1 do: + [:i| + objectMemory + storePointerUnchecked: i + ofObject: stack + withValue: objectMemory nilObject]. + objectMemory pushRemappableOop: (theStack := stack). + 1 to: finger - 1 do: + [:i| | thePage theFP theFPAbove | + objOrFP := objectMemory fetchPointer: i ofObject: theStack. + (self isIntegerObject: objOrFP) ifTrue: + [theFP := self withoutSmallIntegerTags: objOrFP. + thePage := stackPages stackPageFor: theFP. + theFPAbove := self findFrameAbove: theFP inPage: thePage. + objOrFP := self ensureFrameIsMarried: theFP SP: (self frameCallerSP: theFPAbove). + theStack := objectMemory topRemappableOop. + objectMemory "after a GC stack may no longer be a root." + storePointer: finger + ofObject: theStack + withValue: objOrFP]]. + objectMemory popRemappableOop! Item was added: + ----- Method: StackInterpreterPrimitives>>unmarkAfterPathTo (in category 'object access primitives') ----- + unmarkAfterPathTo + <inline: false> + self unmarkAllFrames. + objectMemory unmarkAllObjects! Item was added: + ----- Method: StackInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') ----- + unmarkAllFrames + | thePage theFP flags | + <var: #thePage type: #'StackPage *'> + <var: #theFP type: #'char *'> + <inline: false> + 0 to: numStackPages - 1 do: + [:i| + thePage := stackPages stackPageAt: i. + (stackPages isFree: thePage) ifFalse: + [theFP := thePage headFP. + [flags := self longAt: theFP + FoxFrameFlags. + (flags bitAnd: 2) ~= 0 ifTrue: + [self longAt: theFP + FoxFrameFlags put: flags - 2]. + (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]! Item was changed: ----- Method: StackToRegisterMappingCogit class>>callingConvention (in category 'documentation') ----- callingConvention + "The Smalltalk-to-Smalltalk calling convention aims to trade simplicity of compilation against + effectiveness of optimization. Most Smalltalk methods, and certainly most performance- + critical primitives have two or less arguments. So arranging that the receiver and up to two + args args are in registers arranges that performance-critical primitives can access their + arguments in registers. So if the argument count is <= numRegArgs nothing is passed on + the stack and everything is passed in ReceiverResultReg, Arg0Reg et al. Above numRegArgs - "The calling convention aims to trade simplicity of compilation against effectiveness of optimization. - Most Smalltalk methods, and certainly most performance-critical primitives have two or less arguments. - So arranging that the receiver and up to two args args are in registers arranges that performance-critical - primitives can access their arguments in registers. So if the argument count is <= numRegArgs nothing - is passed on the stack and everything is passed in ReceiverResultReg, Arg0Reg et al. Above numRegArgs everything is passed on the stack. + To save the CoInterpreter from change we shuffle the retpc and push the register args in + the prolog so that the frame format is unchanged by register args. Also, the trampolines for + unlinked sends do the same, as does the code preceeding an interpreter primitive. It turns + out that this protocol is faster than always pushing arguments. Comparing benchFib with the + shuffling protocol against an always-push protocol on a 2.66 GHz Core i7 (MacBook Pro) , the + shuffling protocol is 6.3% faster than the always push protocol. - To save the CoInterpreter from change we shuffle the retpc and push the register args in the prolog so - that the frame format is unchanged by register args. Also, the trampolines for unlinked sends do the same, - as does the code preceeding an interpreter primitive. It turns out that this protocol is faster than always - pushing arguments. Comparing benchFib with the shuffling protocol against an always-push protocol on a - 2.66 GHz Core i7 (MacBook Pro) , the shuffling protocol is 6.3% faster than the always push protocol. + Not shuffling the stack and pushing register arguments after frame build is faster yet again, + 5.8% faster that the stack shuffle. So it might be worth-while to change the CoInterpreter's + frame management to allow numArgs <= numRegArgs frames to push receiver and arguments + after saving the return pc. This implies changes in stack-to-context mapping, GC, + interpreter-to-machine code frame conversion and no doubt else where. + + Hence the calling convention is + + - if the number of arguments is less than or equal to numRegArgs then the receiver and arguments + are passed in registers. numRegArgs is currently 1, but will become 2 once the code generator + generates machine code primitives which take 2 arguments (i.e. once the object representation + makes it feasible to implement at:put: in machine code numRegArgs will be raised to 2). The receiver + is passed in ReceiverResultReg, the first argument in Arg0Reg (esi on x86) and the second argument + (if numRegArgs = 2) in Arg1Reg (edi on x86). + + - if the number of arguments is greater than numRegArgs then the calling convention is as for + SimpleStackBasedCogIt; ReceiverResultReg contains the receiver, and the receiver and arguments + are all on the stack, receiver furthest from top-of-stack. If the argument count is > 2 then argument + count is passed in SendNumArgsReg (for the benefit of the run-time linking routines; it is ignored in + linked sends). + + On return the result is in ReceiverResultReg. The callee removes arguments from the stack. + + Note that if a machine code method contains a call to an interpreter primitive it will push any register + arguments on the stack before calling the primitive so that to the primitive the stack looks the same + as it does in the interpreter. + + Within all machine code primitives except primitiveClosureValue all arguments are taken form registers + since no machine code primitiver has more than numRegArgs arguments. primitiveClosureValue pushes + its register arguments immedately only for laziness to be able to reuse SimpleStackBasedCogit's code. + + Within machine code methods with interpreter primtiives the register arguments are pushed before calling + the interpreter primitive. In normal methods and if not already done so in [primitive code, the register + arguments are pushed during frame build. If a method is compiled frameless it will access its arguments + in registers."! - Not shuffling the stack and pushing register arguments after frame build is faster yet again, 5.8% faster - that the stack shuffle. So it could be worth-while to change the CoInterpreter's frame management to - allow numArgs <= numRegArgs frames to push receiver and arguments after saving the return pc. This - implies changes in stack-to-context mapping, GC, interpreter-to-machine code frame conversion and no - doubt else where."! Item was changed: ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV3PlusClosures (in category 'class initialization') ----- initializeBytecodeTableForNewspeakV3PlusClosures "StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV3PlusClosures" isPushNilFunction := #v3:Is:Push:Nil:. pushNilSizeFunction := #v3PushNilSize:. + NSSendIsPCAnnotated := true. "IsNSSendCall used by PushImplicitReceiver" self flag: 'Special selector send class must be inlined to agree with the interpreter, which inlines class. If class is sent to e.g. a general instance of ProtoObject then unless class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit have identical semantics. We get away with not hardwiring the other special selectors either because in the Cointerpreter they are not inlined or because they are inlined only to instances of classes for which there will always be a method.'. self generatorTableFrom: #( (1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1) (1 16 31 genPushTemporaryVariableBytecode) (1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1) (1 64 95 genPushLiteralVariableBytecode needsFrameNever: 1) (1 96 103 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability" (1 104 111 genStoreAndPopTemporaryVariableBytecode) (1 112 112 genPushReceiverBytecode needsFrameNever: 1) (1 113 113 genPushConstantTrueBytecode needsFrameNever: 1) (1 114 114 genPushConstantFalseBytecode needsFrameNever: 1) (1 115 115 genPushConstantNilBytecode needsFrameNever: 1) (1 116 119 genPushQuickIntegerConstantBytecode needsFrameNever: 1) "method returns in blocks need a frame because of nonlocalReturn:through:" (1 120 120 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0) (1 121 121 genReturnTrue return needsFrameIfInBlock: isMappedInBlock 0) (1 122 122 genReturnFalse return needsFrameIfInBlock: isMappedInBlock 0) (1 123 123 genReturnNil return needsFrameIfInBlock: isMappedInBlock 0) (1 124 124 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1) (1 125 125 genReturnTopFromBlock return needsFrameNever: -1) (3 126 126 genDynamicSuperSendBytecode isMapped) "Newspeak" (2 127 127 genPushImplicitReceiverBytecode isMapped) "Newspeak" (2 128 128 extendedPushBytecode needsFrameNever: 1) (2 129 129 extendedStoreBytecode) (2 130 130 extendedStoreAndPopBytecode) (2 131 131 genExtendedSendBytecode isMapped) (3 132 132 doubleExtendedDoAnythingBytecode isMapped) (2 133 133 genExtendedSuperBytecode isMapped) (2 134 134 genSecondExtendedSendBytecode isMapped) (1 135 135 genPopStackBytecode needsFrameNever: -1) (1 136 136 duplicateTopBytecode needsFrameNever: 1) (1 137 137 genPushActiveContextBytecode) (2 138 138 genPushNewArrayBytecode) (2 139 139 genPushExplicitOuterSendReceiverBytecode isMapped) "Newspeak" (3 140 140 genPushRemoteTempLongBytecode) (3 141 141 genStoreRemoteTempLongBytecode) (3 142 142 genStoreAndPopRemoteTempLongBytecode) (4 143 143 genPushClosureCopyCopiedValuesBytecode block v3:Block:Code:Size:) (1 144 151 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:) (1 152 159 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v3:ShortForward:Branch:Distance:) (2 160 163 genLongUnconditionalBackwardJump branch isMapped "because of interrupt check" v3:Long:Branch:Distance:) (2 164 167 genLongUnconditionalForwardJump branch v3:Long:Branch:Distance:) (2 168 171 genLongJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v3:LongForward:Branch:Distance:) (2 172 175 genLongJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v3:LongForward:Branch:Distance:) (1 176 176 genSpecialSelectorArithmetic isMapped AddRR) (1 177 177 genSpecialSelectorArithmetic isMapped SubRR) (1 178 178 genSpecialSelectorComparison isMapped JumpLess) (1 179 179 genSpecialSelectorComparison isMapped JumpGreater) (1 180 180 genSpecialSelectorComparison isMapped JumpLessOrEqual) (1 181 181 genSpecialSelectorComparison isMapped JumpGreaterOrEqual) (1 182 182 genSpecialSelectorComparison isMapped JumpZero) (1 183 183 genSpecialSelectorComparison isMapped JumpNonZero) (1 184 189 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //" (1 190 190 genSpecialSelectorArithmetic isMapped AndRR) (1 191 191 genSpecialSelectorArithmetic isMapped OrRR) (1 192 197 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd" (1 198 198 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)" (1 199 199 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)" (1 200 207 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y" (1 208 223 genSendLiteralSelector0ArgsBytecode isMapped) (1 224 239 genSendLiteralSelector1ArgBytecode isMapped) (1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))! Item was changed: ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') ----- initializeBytecodeTableForNewspeakV4 "StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV4" isPushNilFunction := #v4:Is:Push:Nil:. pushNilSizeFunction := #v4PushNilSize:. + NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit" self flag: 'Special selector send class must be inlined to agree with the interpreter, which inlines class. If class is sent to e.g. a general instance of ProtoObject then unless class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit have identical semantics. We get away with not hardwiring the other special selectors either because in the Cointerpreter they are not inlined or because they are inlined only to instances of classes for which there will always be a method.'. self generatorTableFrom: #( "1 byte bytecodes" (1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1) (1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1) (1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1) (1 64 75 genPushTemporaryVariableBytecode) (1 76 76 genPushReceiverBytecode needsFrameNever: 1) (1 77 77 genExtPushPseudoVariableOrOuterBytecode) (1 78 78 genPushConstantZeroBytecode needsFrameNever: 1) (1 79 79 genPushConstantOneBytecode needsFrameNever: 1) (1 80 80 genSpecialSelectorArithmetic isMapped AddRR) (1 81 81 genSpecialSelectorArithmetic isMapped SubRR) (1 82 82 genSpecialSelectorComparison isMapped JumpLess) (1 83 83 genSpecialSelectorComparison isMapped JumpGreater) (1 84 84 genSpecialSelectorComparison isMapped JumpLessOrEqual) (1 85 85 genSpecialSelectorComparison isMapped JumpGreaterOrEqual) (1 86 86 genSpecialSelectorComparison isMapped JumpZero) (1 87 87 genSpecialSelectorComparison isMapped JumpNonZero) (1 88 93 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //" (1 94 94 genSpecialSelectorArithmetic isMapped AndRR) (1 95 95 genSpecialSelectorArithmetic isMapped OrRR) (1 96 101 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd" (1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)" (1 103 103 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)" (1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y" (1 112 127 genSendLiteralSelector0ArgsBytecode isMapped) (1 128 143 genSendLiteralSelector1ArgBytecode isMapped) (1 144 159 genSendLiteralSelector2ArgsBytecode isMapped) (1 160 175 genSendAbsentImplicit0ArgsBytecode isMapped) (1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability" (1 184 191 genStoreAndPopTemporaryVariableBytecode) (1 192 199 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:) (1 200 207 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v3:ShortForward:Branch:Distance:) (1 208 215 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v3:ShortForward:Branch:Distance:) (1 216 216 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0) (1 217 217 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1) (1 218 218 genExtReturnTopFromBlock return needsFrameNever: -1) (1 219 219 duplicateTopBytecode needsFrameNever: 1) (1 220 220 genPopStackBytecode needsFrameNever: -1) (1 221 221 genExtNopBytecode needsFrameNever: 0) (1 222 223 unknownBytecode) "2 byte bytecodes" (2 224 224 extABytecode extension needsFrameNever: 0) (2 225 225 extBBytecode extension needsFrameNever: 0) (2 226 226 genExtPushReceiverVariableBytecode) (2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1) (2 228 228 genExtPushLiteralBytecode needsFrameNever: 1) (2 229 229 genExtPushIntegerBytecode needsFrameNever: 1) (2 230 230 genLongPushTemporaryVariableBytecode) (2 231 231 genPushNewArrayBytecode) (2 232 232 genExtStoreReceiverVariableBytecode) (2 233 233 genExtStoreLiteralVariableBytecode) (2 234 234 genLongStoreTemporaryVariableBytecode) (2 235 235 genExtStoreAndPopReceiverVariableBytecode) (2 236 236 genExtStoreAndPopLiteralVariableBytecode) (2 237 237 genLongStoreAndPopTemporaryVariableBytecode) (2 238 238 genExtSendBytecode isMapped) (2 239 239 genExtSendSuperBytecode isMapped) (2 240 240 genExtSendAbsentImplicitBytecode isMapped) (2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped) (2 242 242 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:) (2 243 243 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:) (2 244 244 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:) (2 245 248 unknownBytecode) "3 byte bytecodes" (3 249 249 callPrimitiveBytecode) (3 250 250 genPushRemoteTempLongBytecode) (3 251 251 genStoreRemoteTempLongBytecode) (3 252 252 genStoreAndPopRemoteTempLongBytecode) (3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:) (3 254 255 unknownBytecode))! Item was removed: - ----- Method: StackToRegisterMappingCogit>>genGetImplicitReceiverFor: (in category 'bytecode generators') ----- - genGetImplicitReceiverFor: selector - "Cached implicit receiver implementation. Caller looks like - mov selector, ClassReg - call cePushImplicitReceiver - br continue - Lclass .word - Lmixin: .word - continue: - If class matches class of receiver then mixin contains either 0 or the implicit receiver. - If 0, answer the actual receiver. This is done in the trampoline. - See generateNewspeakRuntime." - self ssAllocateCallReg: SendNumArgsReg and: ReceiverResultReg and: ClassReg and: Arg1Reg. - ^super genGetImplicitReceiverFor: selector! Item was added: + ----- Method: StackToRegisterMappingCogit>>genGetImplicitReceiverFor:forPush: (in category 'bytecode generators') ----- + genGetImplicitReceiverFor: selector forPush: forPushSendBar + "Cached implicit receiver implementation. Caller looks like + mov selector, ClassReg + call cePushImplicitReceiver + br continue + Lclass .word + Lmixin: .word + continue: + If class matches class of receiver then mixin contains either 0 or the implicit receiver. + If 0, answer the actual receiver. This is done in the trampoline. + See generateNewspeakRuntime." + self ssAllocateCallReg: SendNumArgsReg and: ReceiverResultReg and: ClassReg and: Arg1Reg. + ^super genGetImplicitReceiverFor: selector forPush: forPushSendBar! Item was changed: ----- Method: StackToRegisterMappingCogit>>genPushImplicitReceiverBytecode (in category 'bytecode generators') ----- genPushImplicitReceiverBytecode | result | + result := self genGetImplicitReceiverFor: (self getLiteral: byte1) forPush: true. - result := self genGetImplicitReceiverFor: (self getLiteral: byte1). result ~= 0 ifTrue: [^result]. ^self ssPushRegister: ReceiverResultReg! Item was changed: ----- Method: StackToRegisterMappingCogit>>genSendAbsentImplicit:numArgs: (in category 'bytecode generators') ----- genSendAbsentImplicit: selector numArgs: numArgs "Get the implicit receiver and marshall arguments, shuffling the stack to push the implicit receiver if necessary. Then send." <inline: false> | result | + "This must not be PC-mapped" + result := self genGetImplicitReceiverFor: selector forPush: false. - result := self genGetImplicitReceiverFor: selector. result ~= 0 ifTrue: [^result]. self marshallImplicitReceiverSendArguments: numArgs. ^self genMarshalledSend: selector numArgs: numArgs! Item was changed: ----- Method: StackToRegisterMappingCogit>>prevInstIsPCAnnotated (in category 'testing') ----- prevInstIsPCAnnotated | annotation prevIndex prevInst | <var: #annotation type: #'InstructionAnnotation *'> <var: #prevInst type: #'AbstractInstruction *'> annotationIndex > 0 ifFalse: [^false]. annotation := self addressOf: (annotations at: annotationIndex - 1). + (self isPCMappedAnnotation: annotation annotation + alternateInstructionSet: bytecodeSetOffset > 0) ifFalse: - (self isPCMappedAnnotation: annotation annotation) ifFalse: [^false]. prevIndex := opcodeIndex - 1. [prevIndex <= 0 ifTrue: [^false]. prevInst := self abstractInstructionAt: prevIndex. annotation instruction = prevInst ifTrue: [^true]. prevInst opcode = Label] whileTrue: [prevIndex := prevIndex - 1]. ^false! Item was changed: ----- Method: TMethod>>addVarsDeclarationsAndLabelsOf:except: (in category 'inlining support') ----- addVarsDeclarationsAndLabelsOf: methodToBeInlined except: doNotRename "Prepare to inline the body of the given method into the receiver by making the args and locals of the argument to the receiver be locals of the receiver. Record any type declarations for these variables. Record labels. Assumes that the variables have already be renamed to avoid name clashes." + locals + addAll: (methodToBeInlined args reject: [ :v | doNotRename includes: v]); + addAll: (methodToBeInlined locals reject: [ :v | doNotRename includes: v]). - methodToBeInlined args, methodToBeInlined locals do: - [ :v | - ((doNotRename includes: v) - or: [locals includes: v]) ifFalse: - [locals addLast: v]]. - methodToBeInlined declarations keysAndValuesDo: [ :v :decl | (doNotRename includes: v) ifFalse: [self declarationAt: v put: decl]]. + labels addAll: methodToBeInlined labels! - methodToBeInlined labels do: - [ :label | - labels add: label]! Item was changed: ----- Method: TMethod>>computePossibleSideEffectsInto:visited:in: (in category 'inlining support') ----- computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen + "Add all variables written to by this method and its callees to writtenToVars. - "Add all variables written to by this mathod and its callees to writtenToVars. Avoid circularity via visitedSelectors" (visitedSelectors includes: selector) ifTrue: [^self]. visitedSelectors add: selector. writtenToGlobalVarsCache ifNotNil: [writtenToVars addAll: writtenToGlobalVarsCache. ^self]. parseTree nodesDo: [ :node | (node isAssignment and: [(locals includes: node variable name) not]) ifTrue: [writtenToVars add: node variable name]. (node isSend + and: [node isBuiltinOperator not + and: [(node isStructSend: aCodeGen) not]]) ifTrue: - and: [node isBuiltinOperator not]) ifTrue: [(aCodeGen methodNamed: node selector) ifNotNil: [:method| method computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen]]]. writtenToGlobalVarsCache := writtenToVars copy! Item was changed: ----- Method: TMethod>>emitInlineOn:level:generator: (in category 'C code generation') ----- emitInlineOn: aStream level: level generator: aCodeGen "Emit C code for this method onto the given stream. All calls to inlined methods should already have been expanded." self removeUnusedTemps. sharedLabel ifNotNil: [aStream crtab: level-1; nextPutAll: sharedLabel; nextPut: $:. aStream crtab: level. aStream nextPutAll: '/* '; nextPutAll: selector; nextPutAll: ' */'. aStream crtab: level]. aStream nextPut: ${. locals isEmpty ifFalse: + [(aCodeGen sortStrings: locals) do: - [locals do: [:var| aStream crtab: level+1; nextPutAll: (self declarationAt: var); nextPut: $;]. aStream cr]. aStream crtab: level+1. aCodeGen outputAsmLabel: selector on: aStream. aStream crtab: level+1. aCodeGen pushScope: declarations while: [parseTree emitCCodeOn: aStream level: level+1 generator: aCodeGen]. aStream tab: level; nextPut: $}! Item was changed: ----- Method: TMethod>>inlineCaseStatementBranchesIn:localizingVars: (in category 'inlining') ----- inlineCaseStatementBranchesIn: aCodeGen localizingVars: varsList | maxTemp usedVars v exitLabel | maxTemp := 0. parseTree nodesDo: [:n | n isCaseStmt ifTrue: [n cases do: [:stmtNode | | newStatements stmt meth | (stmt := stmtNode statements first) isSend ifTrue: [(meth := (aCodeGen methodNamed: stmt selector)) isNil ifFalse: [(meth hasUnrenamableCCode or: [meth args notEmpty]) ifFalse: [meth := meth copy. meth hasReturn ifTrue: [exitLabel := meth unusedLabelForInliningInto: self. meth exitVar: nil label: exitLabel. labels add: exitLabel] ifFalse: [exitLabel := nil]. meth renameLabelsForInliningInto: self. labels addAll: meth labels. newStatements := stmtNode statements asOrderedCollection allButFirst. exitLabel ifNotNil: [newStatements addFirst: (TLabeledCommentNode new setLabel: exitLabel comment: 'end case')]. newStatements addFirst: meth asInlineNode; addFirst: (TLabeledCommentNode new setComment: meth selector). stmtNode setStatements: newStatements]]]]]]. usedVars := (locals , args) asSet. 1 to: maxTemp do: [:i | v := 't' , i printString. (usedVars includes: v) ifTrue: [self error: 'temp variable name conflicts with an existing local or arg']. locals addLast: v]. "make local versions of the given globals" + locals addAll: (varsList reject: [:var | usedVars includes: var])! - varsList do: - [:var | - (usedVars includes: var) ifFalse: - [locals addFirst: var asString]]! Item was removed: - ----- Method: TMethod>>isLocal: (in category 'testing') ----- - isLocal: aVariableName - ^locals includes: aVariableName! Item was added: + ----- Method: TMethod>>oopVariable: (in category 'private') ----- + oopVariable: aString + + (locals includes: aString) ifFalse: + [locals add: aString. + self declarationAt: aString put: 'sqInt ', aString]. + ^TVariableNode new setName: aString! Item was changed: ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') ----- prepareMethodIn: aCodeGen "Record sends of builtin operators, map sends of the special selector dispatchOn:in: with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements. Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:]. These must be top-level statements; they cannot appear in expressions. As a hack also update the types of variables introduced to implement cascades correctly. This has to be done at teh same time as this is done, so why not piggy back here?" | replacements |. cascadeVariableNumber ifNotNil: [declarations keysAndValuesDo: [:varName :decl| decl isBlock ifTrue: [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]). locals add: varName. self declarationAt: varName put: (decl value: self value: aCodeGen), ' ', varName]]]. replacements := IdentityDictionary new. + aCodeGen + pushScope: declarations + while: + [parseTree nodesDo: + [:node| + node isSend ifTrue: + [(aCodeGen builtin: node selector) + ifTrue: + [node isBuiltinOperator: true. + "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args" + (node selector = #to:by:do: + and: [node args size = 4]) ifTrue: + [| limitExpr | + limitExpr := node args first. + (limitExpr anySatisfy: + [:subNode| + subNode isSend + and: [(aCodeGen builtin: subNode selector) not + and: [(subNode isStructSend: aCodeGen) not]]]) + ifTrue: [locals add: node args last name] + ifFalse: + [node arguments: node args allButLast]]] + ifFalse: + [(CaseStatements includes: node selector) ifTrue: + [replacements at: node put: (self buildCaseStmt: node)]. + (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: + [replacements at: node put: (self buildSwitchStmt: node)]]]. + ((node isAssignment or: [node isReturn]) + and: [node expression isSwitch]) ifTrue: + [replacements at: node put: (self transformSwitchExpression: node)]]]. - parseTree nodesDo: - [:node| - node isSend ifTrue: - [(aCodeGen builtin: node selector) - ifTrue: - [node isBuiltinOperator: true] - ifFalse: - [(CaseStatements includes: node selector) ifTrue: - [replacements at: node put: (self buildCaseStmt: node)]. - (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: - [replacements at: node put: (self buildSwitchStmt: node)]]]. - ((node isAssignment or: [node isReturn]) - and: [node expression isSwitch]) ifTrue: - [replacements at: node put: (self transformSwitchExpression: node)]]. - replacements isEmpty ifFalse: + [parseTree := parseTree replaceNodesIn: replacements]! - [parseTree := parseTree replaceNodesIn: replacements] - ! Item was changed: ----- Method: TMethod>>preparePrimitivePrologue (in category 'primitive compilation') ----- preparePrimitivePrologue "Add a prolog and postlog to a primitive method. The prolog copies any instance variables referenced by this primitive method into local variables. The postlog copies values of assigned-to variables back into the instance. The names of the new locals are added to the local variables list. The declarations dictionary defines the types of any non-integer variables (locals, arguments, or instance variables). In particular, it may specify the types: int * -- an array of 32-bit values (e.g., a BitMap) short * -- an array of 16-bit values (e.g., a SoundBuffer) char * -- an array of unsigned bytes (e.g., a String) double -- a double precision floating point number (e.g., 3.14159) Undeclared variables are taken to be integers and will be converted from Smalltalk to C ints." "Current restrictions: o method must not contain message sends o method must not allocate objects o method must not manipulate raw oops o method cannot access class variables o method can only return an integer" | prolog postlog instVarsUsed varsAssignedTo instVarList primArgCount varName endsWithReturn aClass | + self assert: selector ~~ #setInterpreter:. - selector == #setInterpreter: ifTrue:[self halt]. aClass := definingClass. prolog := OrderedCollection new. postlog := OrderedCollection new. instVarsUsed := self freeVariableReferences asSet. varsAssignedTo := self variablesAssignedTo asSet. instVarList := aClass allInstVarNames. primArgCount := args size. "add receiver fetch and arg conversions to prolog" prolog addAll: self fetchRcvrExpr. 1 to: args size do: [:argIndex | varName := args at: argIndex. prolog addAll: (self argConversionExprFor: varName stackIndex: args size - argIndex)]. "add success check to postlog" postlog addAll: self checkSuccessExpr. "add instance variable fetches to prolog and instance variable stores to postlog" 1 to: instVarList size do: [:varIndex | varName := instVarList at: varIndex. (instVarsUsed includes: varName) ifTrue: [ locals add: varName. prolog addAll: (self instVarGetExprFor: varName offset: varIndex - 1). (varsAssignedTo includes: varName) ifTrue: [ postlog addAll: (self instVarPutExprFor: varName offset: varIndex - 1)]]]. prolog addAll: self checkSuccessExpr. + ((locals includes: 'rcvr') or: [(locals intersection: args) notEmpty]) ifTrue: + [self error: 'local name conflicts with instance variable name']. + locals add: 'rcvr'; addAll: args. - locals addAllFirst: args. - locals addFirst: 'rcvr'. args := args class new. - locals asSet size = locals size - ifFalse: [self error: 'local name conflicts with instance variable name']. endsWithReturn := self endsWithReturn. self fixUpReturns: primArgCount postlog: postlog. endsWithReturn ifTrue: [parseTree setStatements: prolog, parseTree statements] ifFalse: [ postlog addAll: (self popArgsExpr: primArgCount). parseTree setStatements: prolog, parseTree statements, postlog]. ! Item was changed: ----- Method: TMethod>>renameVarsForInliningInto:except:in: (in category 'inlining support') ----- renameVarsForInliningInto: destMethod except: doNotRename in: aCodeGen "Rename any variables that would clash with those of the destination method." | destVars usedVars varMap newVarName | destVars := aCodeGen globalsAsSet copy. destVars addAll: destMethod locals. destVars addAll: destMethod args. usedVars := destVars copy. "keeps track of names in use" usedVars addAll: args; addAll: locals. varMap := Dictionary new: 100. + locals, args do: + [ :v | - args, locals do: [ :v | ((doNotRename includes: v) not + and: [destVars includes: v]) ifTrue: + [newVarName := self unusedNamePrefixedBy: v avoiding: usedVars. + varMap at: v put: newVarName]]. + self renameVariablesUsing: varMap! - and: [destVars includes: v]) ifTrue: [ - newVarName := self unusedNamePrefixedBy: v avoiding: usedVars. - varMap at: v put: newVarName. - ]. - ]. - self renameVariablesUsing: varMap.! Item was changed: ----- Method: TMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initialization') ----- setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment "Initialize this method using the given information." selector := sel. definingClass := class. returnType := #sqInt. "assume return type is long for now" args := argList asOrderedCollection collect: [:arg | arg key]. + locals := (localList collect: [:arg | arg key]) asSet. - locals := (localList asSortedCollection: [:a :b| a key < b key]) collect: [:arg | arg key]. declarations := Dictionary new. self addTypeForSelf. primitive := aNumber. properties := methodProperties. comment := aComment. parseTree := aBlockNode. "hack; allows nodes to find their parent, etc" parseTree := aBlockNode asTranslatorNodeIn: self. labels := OrderedCollection new. complete := false. "set to true when all possible inlining has been done" export := self extractExportDirective. static := self extractStaticDirective. canAsmLabel := self extractLabelDirective. self extractSharedCase. self removeFinalSelfReturn. "must preceed recordDeclarations because this may set returnType" self recordDeclarations. globalStructureBuildMethodHasFoo := 0! Item was changed: ----- Method: TMethod>>superExpansionNodeFor:args: (in category 'inlining') ----- superExpansionNodeFor: aSelector args: argumentNodes "Answer the expansion of a super send. Merge the super expansion's locals, properties and comment into this method's properties." (definingClass superclass lookupSelector: aSelector) ifNil: [self error: 'superclass does not define super method'] ifNotNil: [:superMethod| | superTMethod commonVars varMap | superTMethod := superMethod methodNode asTranslationMethodOfClass: self class. ((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode]) and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse: [self error: definingClass name, '>>',selector, ' args ~= ', superTMethod definingClass name, '>>', aSelector, (String with: $. with: Character cr), 'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.']. self mergePropertiesOfSuperMethod: superTMethod. (commonVars := superTMethod locals intersection: self locals) notEmpty ifTrue: [varMap := Dictionary new. commonVars do: [:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)]. superTMethod renameVariablesUsing: varMap]. self assert: (superTMethod locals allSatisfy: [:var| (self locals includes: var) not]). + locals addAll: superTMethod locals. - locals addAllFirst: superTMethod locals. superTMethod declarations keysAndValuesDo: [:var :decl| self declarationAt: var put: decl]. superTMethod comment ifNotNil: [:superComment| comment := comment ifNil: [superComment] ifNotNil: [superComment, comment]]. superTMethod cascadeVariableNumber ifNotNil: [:scvn| cascadeVariableNumber := cascadeVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]]. superTMethod elideAnyFinalReturn. ^superTMethod parseTree]! Item was added: + ----- Method: TParseNode>>anySatisfy: (in category 'enumerating') ----- + anySatisfy: aBlock + self nodesDo: [:n| (aBlock value: n) ifTrue: [^true]]. + ^false! Item was added: + ----- Method: TParseNode>>noneSatisfy: (in category 'enumerating') ----- + noneSatisfy: aBlock + self nodesDo: [:n| (aBlock value: n) ifTrue: [^false]]. + ^true! Item was changed: ----- Method: TSendNode>>printOn:level: (in category 'printing') ----- printOn: aStream level: level | possiblyParenthesize | possiblyParenthesize := [:node :newLevel| (node isSend and: [node selector precedence >= 3]) ifTrue: [aStream nextPut: $(]. node printOn: aStream level: newLevel. (node isSend and: [node selector precedence >= 3]) ifTrue: [aStream nextPut: $)]]. possiblyParenthesize value: receiver value: level. arguments size = 0 ifTrue: [aStream space; nextPutAll: selector. ^self]. + selector keywords with: (arguments first: selector numArgs) do: - selector keywords with: arguments do: [:keyword :arg | aStream space; nextPutAll: keyword; space. possiblyParenthesize value: arg value: level + 1]! Item was changed: Object subclass: #VMClass instanceVariableNames: '' + classVariableNames: 'DefaultBase' - classVariableNames: '' poolDictionaries: 'VMBasicConstants' category: 'VMMaker-Support'! VMClass class instanceVariableNames: 'timeStamp'! !VMClass commentStamp: '<historical>' prior: 0! I am an abstract superclass for all classes in the VM that want to maintain a source timeStamp.! VMClass class instanceVariableNames: 'timeStamp'! Item was changed: ----- Method: VMClass class>>defaultIntegerBaseInDebugger (in category 'debugger') ----- defaultIntegerBaseInDebugger + "DefaultBase := 16." + "DefaultBase := 10." + DefaultBase isNil ifTrue: [DefaultBase := 16]. + ^DefaultBase! - ^16! Item was changed: ----- Method: VMMaker class>>generateNewspeakCogVM (in category 'configurations') ----- generateNewspeakCogVM ^VMMaker generate: CoInterpreter and: StackToRegisterMappingCogit"Cogit chooseCogitClass" with: #( NewspeakVM true MULTIPLEBYTECODESETS true) to: (FileDirectory default pathFromURI: 'oscogvm/nscogsrc') + platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms') - platformDir: (FileDirectory default pathFromURI: '../Newspeak/newclosurevm/platforms') including:#( AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation DSAPlugin DropPlugin FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin InflatePlugin JPEGReadWriter2Plugin JPEGReaderPlugin LargeIntegersPlugin Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin + RePlugin SecurityPlugin SocketPlugin SoundPlugin SqueakSSLPlugin SurfacePlugin ThreadedIA32FFIPlugin - RePlugin SecurityPlugin SocketPlugin SoundPlugin SurfacePlugin ThreadedIA32FFIPlugin UUIDPlugin UnixOSProcessPlugin VMProfileMacSupportPlugin Win32OSProcessPlugin)! Item was changed: ----- Method: VMMaker class>>generateNewspeakInterpreterVM (in category 'configurations') ----- generateNewspeakInterpreterVM ^VMMaker generate: NewspeakInterpreter to: (FileDirectory default pathFromURI: 'oscogvm/nssrc') + platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms') - platformDir: (FileDirectory default pathFromURI: '../Newspeak/newclosurevm/platforms') including:#( AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation DSAPlugin DropPlugin FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin InflatePlugin JPEGReadWriter2Plugin JPEGReaderPlugin LargeIntegersPlugin Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin + RePlugin SecurityPlugin SocketPlugin SoundPlugin SqueakSSLPlugin SurfacePlugin + UUIDPlugin UnixOSProcessPlugin VMProfileMacSupportPlugin Win32OSProcessPlugin)! - RePlugin SecurityPlugin SocketPlugin SoundPlugin SurfacePlugin UUIDPlugin UnixOSProcessPlugin - VMProfileMacSupportPlugin Win32OSProcessPlugin)! Item was changed: ----- Method: VMMaker class>>generateNewspeakStackVM (in category 'configurations') ----- generateNewspeakStackVM ^VMMaker generate: StackInterpreter with: #(NewspeakVM true MULTIPLEBYTECODESETS true) to: (FileDirectory default pathFromURI: 'oscogvm/nsstacksrc') + platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms') - platformDir: (FileDirectory default pathFromURI: '../Newspeak/newclosurevm/platforms') including:#( AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation DSAPlugin DropPlugin FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin InflatePlugin JPEGReadWriter2Plugin JPEGReaderPlugin LargeIntegersPlugin Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin + RePlugin SecurityPlugin SocketPlugin SoundPlugin SurfacePlugin SqueakSSLPlugin ThreadedIA32FFIPlugin - RePlugin SecurityPlugin SocketPlugin SoundPlugin SurfacePlugin ThreadedIA32FFIPlugin UUIDPlugin UnixOSProcessPlugin VMProfileMacSupportPlugin Win32OSProcessPlugin)! Item was changed: ----- Method: VMMaker class>>generateSqueakCogSistaVM (in category 'configurations') ----- generateSqueakCogSistaVM ^VMMaker generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]] value: #(CoInterpreter CoInterpreterMT))) and: SistaStackToRegisterMappingCogit + to: (FileDirectory default pathFromURI: 'oscogvm/sistasrc') + platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms') + excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])! - to: (FileDirectory default pathFromURI: 'cogvm/sistasrc') - platformDir: (FileDirectory default pathFromURI: 'cogvm/platforms') - excluding:#(BrokenPlugin DShowVideoDecoderPlugin NewsqueakIA32ABIPlugin NewsqueakIA32ABIPluginAttic - CroquetPlugin HostWindowPlugin SoundPlugin - QuicktimePlugin QVideoCodecPlugin QwaqMediaPlugin SlangTestPlugin TestOSAPlugin - FFIPlugin ThreadedARMFFIPlugin ThreadedFFIPlugin ThreadedPPCBEFFIPlugin - ReentrantARMFFIPlugin ReentrantFFIPlugin ReentrantIA32FFIPlugin ReentrantPPCBEFFIPlugin)! Item was changed: ----- Method: VMMaker class>>generateSqueakCogVM (in category 'configurations') ----- generateSqueakCogVM ^VMMaker generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]] value: #(CoInterpreter CoInterpreterMT))) and: StackToRegisterMappingCogit with: #( MULTIPLEBYTECODESETS false NewspeakVM false) to: (FileDirectory default pathFromURI: 'oscogvm/src') platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms') + including:#( ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin - including:#( AioPlugin ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin BMPReadWriterPlugin BitBltSimulation BochsIA32Plugin CroquetPlugin DSAPlugin DeflatePlugin DropPlugin FT2Plugin FFTPlugin FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin GeniePlugin HostWindowPlugin IA32ABIPlugin InternetConfigPlugin JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin SecurityPlugin SerialPlugin + SocketPlugin SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin + ThreadedIA32FFIPlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin + Win32OSProcessPlugin VMProfileMacSupportPlugin)! - SocketPlugin SoundCodecPlugin SoundGenerationPlugin SoundPlugin ThreadedIA32FFIPlugin - StarSqueakPlugin UUIDPlugin UnixOSProcessPlugin Win32OSProcessPlugin VMProfileMacSupportPlugin)! Item was changed: ----- Method: VMMaker class>>generateSqueakStackVM (in category 'configurations') ----- generateSqueakStackVM "No primitives since we can use those for the Cog VM" ^VMMaker generate: StackInterpreter + to: (FileDirectory default directoryNamed: 'oscogvm/stacksrc') fullName + platformDir: (FileDirectory default directoryNamed: 'oscogvm/platforms') fullName - to: (FileDirectory default pathFromURI: 'oscogvm/stacksrc') - platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms') excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])! Item was changed: ----- Method: VMMaker>>generateInterpreterFile (in category 'generate sources') ----- generateInterpreterFile "Translate the Smalltalk description of the virtual machine into C. If 'self doInlining' is true, small method bodies are inlined to reduce procedure call overhead. On the PPC, this results in a factor of three speedup with only 30% increase in code size. Subclasses can use specialised versions of CCodeGenerator and interpreterClass." | cg vmHeaderContents | cg := [self buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: self] ifFalse: [(ex respondsTo: #rearmHandlerDuring:) ifTrue: [ex rearmHandlerDuring: [ex pass]] ifFalse: [ex pass]]]. self needsToRegenerateInterpreterFile ifFalse: [^nil]. cg removeUnneededBuiltins. self interpreterClass preGenerationHook: cg. vmHeaderContents := cg vmHeaderContentsWithBytesPerWord: self bytesPerWord. (cg needToGenerateHeader: self interpreterHeaderName file: self interpreterHeaderPath contents: vmHeaderContents) ifTrue: [cg storeHeaderOnFile: self interpreterHeaderPath contents: vmHeaderContents]. cg storeCodeOnFile: (self sourceFilePathFor: self interpreterClass sourceFileName) doInlining: self doInlining. self interpreterClass additionalHeadersDo: [:headerName :headerContents| | filePath | filePath := self coreVMDirectory fullNameFor: headerName. (cg needToGenerateHeader: headerName file: filePath contents: headerContents) ifTrue: [cg storeHeaderOnFile: filePath contents: headerContents]]. self interpreterClass apiExportHeaderName ifNotNil: [cg storeAPIExportHeader: self interpreterClass apiExportHeaderName OnFile: (self sourceFilePathFor: self interpreterClass apiExportHeaderName)]. + self gnuifyInterpreterFile! - (Gnuifier on: self coreVMDirectory) - interpreterFilename: self interpreterFilename; - gnuify.! Item was added: + ----- Method: VMMaker>>gnuifyInterpreterFile (in category 'processing external files') ----- + gnuifyInterpreterFile + "post-process the interp.c file to make it gcc friendly" + (Gnuifier on: self coreVMDirectory) + interpreterFilename: self interpreterFilename; + gnuify.! Item was changed: ----- Method: VMPluginCodeGenerator>>emitCCodeOn:doInlining:doAssertions: (in category 'C code generator') ----- emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag "Generate twice; the first time to collect the used functions, the second to output the used functions." | savedHeaders | savedHeaders := headerFiles copy. [super emitCCodeOn: NullStream new doInlining: inlineFlag doAssertions: assertionFlag] on: MessageNotUnderstood do: [:ex| + (#(cr crtab: ensureCr peekLast space tab tab:) includes: ex message selector) ifTrue: - (#(cr crtab: peekLast space tab tab:) includes: ex message selector) ifTrue: [ex resume: nil]. ex pass]. headerFiles := savedHeaders. super emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag! Item was changed: ----- Method: WordArray class>>ccgDeclareCForVar: (in category '*VMMaker-plugin generation') ----- ccgDeclareCForVar: aSymbolOrString + "Address of an unsigned 32 bit value, regardless of Smalltalk wordSize" + ^'unsigned *', aSymbolOrString! - ^'usqInt *', aSymbolOrString!

1 0

squeakvm on solaris
by Maurizio Boriani 16 Apr '13

16 Apr '13

Hi, using binary vm downloaded from squeakvm (Squeak-4.10.2.2614-solaris2.11_i386.tar.gz <http://www.squeakvm.org/unix/release/Squeak-4.10.2.2614-solaris2.11_i386.ta…>) I've the error: sqConnectToPort: Interrupted system call Is there a known solution/workaround or should I debug this? thanks, bye

2 1

primitiveBitShift
by Helmut Rohregger 15 Apr '13

15 Apr '13

Hi all, i am interested in the implementations of primitives in the VMMaker package and found some code, which i think may be implemented incorrectly. Maybe some of you can help me out and correct me if i am wrong. Its located in InterpreterPrimitives>>#primitiveBitShift (VMMaker-dtl.319): the code: "self success: integerArgument <= 31" checks, if we lose bits by shifting to the left. This is because of processing SmallIntegers here, isn't it? But a "1 bitShift: 31" will produce a LargePositiveInteger instead of a SmallInteger. In fact a left shift of 30 will produce a LargePositiveInteger too. I know the code works, because the resulting object gets checked being a SmallInteger and fails if not. But the correct check would be "self success: integerArgument <= 29", isn't it? What do you think? - helmut

3 6

Problem with recent CMake
by Damien Cassou 15 Apr '13

15 Apr '13

Hi, recent CMake versions won't compile the VM. Error message is always: $ cmake . CMake Error: Could not open file for write in copy operation /CMakeSystem.cmake.tmp CMake Error: : System Error: Permission denied CMake Error at /home/cassou/cmake/Modules/CMakeDetermineSystem.cmake:172 (configure_file): configure_file Problem configuring file Call Stack (most recent call first): CMakeLists.txt:3 (include) I did a git-bisect of the cmake source code to find which cmake's commit stopped working for the VM. The offending cmake commit is: commit 7195aca54f40778f41894c9e62649afe09e71d6c Author: Brad King <brad.king(a)kitware.com> Date: Fri Aug 24 08:48:59 2012 -0400 Make platform information files specific to the CMake version At the top of a build tree we configure inside the CMakeFiles directory files such as "CMakeSystem.cmake" and "CMake<lang>Compiler.cmake" to save information detected about the system and compilers in use. The method of detection and the exact results store varies across CMake versions as things improve. This leads to problems when loading files configured by a different version of CMake. Previously we ignored such existing files only if the major.minor part of the CMake version component changed, and depended on the CMakeCache.txt to tell us the last version of CMake that wrote the files. This led to problems if the user deletes the CMakeCache.txt or we add required information to the files in a patch-level release of CMake (still a "feature point" release by modern CMake versioning convention). Ensure that we always have version-consistent platform information files by storing them in a subdirectory named with the CMake version. Every version of CMake will do its own system and compiler identification checks even when a build tree has already been configured by another version of CMake. Stored results will not clobber those from other versions of CMake which may be run again on the same tree in the future. Loaded results will match what the system and language modules expect. Rename the undocumented variable CMAKE_PLATFORM_ROOT_BIN to CMAKE_PLATFORM_INFO_DIR to clarify its purpose. The new variable points at the version-specific directory while the old variable did not. I attach the patch of this commit to this email. I have no idea what we can do about it. -- Damien Cassou http://damiencassou.seasidehosting.st "Success is the ability to go from one failure to another without losing enthusiasm." Winston Churchill

3 8

Prebuilt 64-bit VM on Linux?
by Hernán Morales Durand 15 Apr '13

15 Apr '13

I have a 64-bit CentOS server and I want a to measure the peak memory usage with valgrind for a script. For that I need a 64-VM (with a 32-bit Pharo image). I have tried with http://www.mirandabanda.org/files/Cog/VM/VM.r2714/coglinux-13.13.2714.tgzbut file reports: "squeak: ELF 32-bit LSB executable, Intel 80386, version 1 (SYSV), dynamically linked (uses shared libs), for GNU/Linux 2.6.9, not stripped" Is there any precompiled linux 64-bit binary available? Cheers Hernán

9 26

Re: [Vm-dev] VM Maker: VMMaker.oscog-eem.281.mcz
by Eliot Miranda 15 Apr '13

15 Apr '13

Guys, please integrate this asap. This is a horrible bug that is probably causing all sorts of crashes in large images on linux, and should have been generally causing horrible crashes all over the place. Bugs are good at lurking :-/. On Wed, Apr 3, 2013 at 3:27 PM, <commits(a)source.squeak.org> wrote: > > Eliot Miranda uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-eem.281.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-eem.281 > Author: eem > Time: 3 April 2013, 3:27:02.058 pm > UUID: 64be55df-6421-4087-a712-5c07419806c7 > Ancestors: VMMaker.oscog-eem.280 > > Cogit: Fix *HORRIBLE* yet ancient bug with the CogObjectRep. > Both CogObjectRepresentationForSqueakV3>>couldBeObject: & > CogObjectRepresentationForSqueakV3>>shouldAnnotateObjectReference: > used signed comparisons for oops and so once the heap size > pushes oops into the upper half of the address space constant > oops in machine code were no longer being updated by the GC. > > StackInterpreter: reqrite the login for printing methods so that > printing the frame of a bad receiver won't seg fault. > > =============== Diff against VMMaker.oscog-eem.280 =============== > > Item was changed: > ----- Method: CogObjectRepresentationForSqueakV3>>couldBeObject: (in > category 'garbage collection') ----- > couldBeObject: oop > ^(objectMemory isNonIntegerObject: oop) > + and: [self oop: oop isGreaterThanOrEqualTo: objectMemory > nilObject]! > - and: [oop asUnsignedInteger >= objectMemory nilObject]! > > Item was changed: > ----- Method: > CogObjectRepresentationForSqueakV3>>shouldAnnotateObjectReference: (in > category 'garbage collection') ----- > shouldAnnotateObjectReference: anOop > "self assert: ((objectMemory isIntegerObject: anOop) > or: [objectMemory addressCouldBeObj: > anOop])." > ^(objectMemory isNonIntegerObject: anOop) > + and: [self oop: anOop isGreaterThan: objectMemory trueObject]! > - and: [anOop > objectMemory trueObject]! > > Item was changed: > ----- Method: StackInterpreter class>>requiredMethodNames (in category > 'translation') ----- > requiredMethodNames > "return the list of method names that should be retained for > export or other support reasons" > | requiredList | > requiredList := self exportAPISelectors. > requiredList addAll: NewObjectMemory requiredMethodNames. > "A number of methods required by VM support code, jitter, specific > platforms etc" > requiredList addAll: #( > assertValidExecutionPointe:r:s: > characterForAscii: checkedLongAt: > delayExpired > + findClassOfMethod:forReceiver: findSelectorOfMethod: > - findClassOfMethod:forReceiver: > findSelectorOfMethod:forReceiver: > forceInterruptCheck > forceInterruptCheckFromHeartbeat fullDisplayUpdate > getCurrentBytecode getFullScreenFlag getInterruptKeycode > getInterruptPending > getSavedWindowSize getThisSessionID > highBit: > interpret > loadInitialContext > oopFromChunk: > primitiveFail primitiveFailFor: > primitiveFlushExternalPrimitives printAllStacks printCallStack printContext: > printExternalHeadFrame printFramesInPage: > printFrame: printHeadFrame printMemory printOop: > printStackPages printStackPageList > printStackPagesInUse printStackPageListInUse > readableFormat: readImageFromFile:HeapSize:StartingAt: > setFullScreenFlag: setInterruptKeycode: > setInterruptPending: setInterruptCheckChain: > setSavedWindowSize: success: > validInstructionPointer:inMethod:framePointer:). > > "Nice to actually have all the primitives available" > requiredList addAll: (self primitiveTable select: [:each| each > isSymbol]). > > "InterpreterProxy is the internal analogue of sqVirtualMachine.c, > so make sure to keep all those" > InterpreterProxy organization categories do: > [:cat | > ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: > [requiredList addAll: (InterpreterProxy > organization listAtCategoryNamed: cat)]]. > > ^requiredList! > > Item was added: > + ----- Method: StackInterpreter>>addressCouldBeClassObj: (in category > 'debug support') ----- > + addressCouldBeClassObj: maybeClassObj > + "Answer if maybeClassObj looks like a class object" > + <inline: false> > + ^(objectMemory addressCouldBeObj: maybeClassObj) > + and: [((objectMemory isPointersNonInt: maybeClassObj) and: > [(objectMemory lengthOf: maybeClassObj) >= 3]) > + and: [(objectMemory isPointersNonInt: (objectMemory > fetchPointer: SuperclassIndex ofObject: maybeClassObj)) > + and: [(objectMemory isPointersNonInt: (objectMemory > fetchPointer: MethodDictionaryIndex ofObject: maybeClassObj)) > + and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: > InstanceSpecificationIndex ofObject: maybeClassObj))]]]]! > > Item was added: > + ----- Method: StackInterpreter>>findClassContainingMethod:startingAt: > (in category 'debug support') ----- > + findClassContainingMethod: meth startingAt: classObj > + | currClass classDict classDictSize methodArray i | > + currClass := classObj. > + [classDict := objectMemory fetchPointer: MethodDictionaryIndex > ofObject: currClass. > + classDictSize := objectMemory fetchWordLengthOf: classDict. > + methodArray := objectMemory fetchPointer: MethodArrayIndex > ofObject: classDict. > + i := 0. > + [i < (classDictSize - SelectorStart)] whileTrue: > + [meth = (objectMemory fetchPointer: i ofObject: > methodArray) ifTrue: > + [^currClass]. > + i := i + 1]. > + currClass := self superclassOf: currClass. > + currClass = objectMemory nilObject] whileFalse. > + ^currClass "method not found in superclass chain"! > > Item was changed: > ----- Method: StackInterpreter>>findClassOfMethod:forReceiver: (in > category 'debug support') ----- > findClassOfMethod: meth forReceiver: rcvr > + | rclass | > + (objectMemory addressCouldBeOop: rcvr) ifTrue: > + [rclass := objectMemory fetchClassOf: rcvr. > + (self addressCouldBeClassObj: rclass) ifTrue: > + [rclass := self findClassContainingMethod: meth > startingAt: rclass. > + rclass ~= objectMemory nilObject ifTrue: > + [^rclass]]]. > - > - | rclass currClass classDict classDictSize methodArray i | > (objectMemory addressCouldBeObj: meth) ifFalse: > [^objectMemory nilObject]. > + ^self findClassContainingMethod: meth startingAt: (self > methodClassOf: meth)! > - (objectMemory addressCouldBeOop: rcvr) > - ifTrue: [rclass := objectMemory fetchClassOf: rcvr] > - ifFalse: [rclass := self methodClassOf: meth]. > - currClass := rclass. > - [classDict := objectMemory fetchPointer: MethodDictionaryIndex > ofObject: currClass. > - classDictSize := objectMemory fetchWordLengthOf: classDict. > - methodArray := objectMemory fetchPointer: MethodArrayIndex > ofObject: classDict. > - i := 0. > - [i < (classDictSize - SelectorStart)] whileTrue: > - [meth = (objectMemory fetchPointer: i ofObject: > methodArray) ifTrue: > - [^currClass]. > - i := i + 1]. > - currClass := self superclassOf: currClass. > - currClass = objectMemory nilObject] whileFalse. > - ^rclass "method not found in superclass chain"! > > Item was added: > + ----- Method: StackInterpreter>>findSelectorOfMethod: (in category > 'debug support') ----- > + findSelectorOfMethod: meth > + | classObj classDict classDictSize methodArray i | > + (objectMemory addressCouldBeObj: meth) ifFalse: > + [^objectMemory nilObject]. > + classObj := self methodClassOf: meth. > + (self addressCouldBeClassObj: classObj) ifTrue: > + [classDict := objectMemory fetchPointer: > MethodDictionaryIndex ofObject: classObj. > + classDictSize := objectMemory fetchWordLengthOf: > classDict. > + methodArray := objectMemory fetchPointer: > MethodArrayIndex ofObject: classDict. > + i := 0. > + [i <= (classDictSize - SelectorStart)] whileTrue: > + [meth = (objectMemory fetchPointer: i ofObject: > methodArray) ifTrue: > + [^(objectMemory fetchPointer: i + > SelectorStart ofObject: classDict)]. > + i := i + 1]]. > + ^objectMemory nilObject! > > Item was removed: > - ----- Method: StackInterpreter>>findSelectorOfMethod:forReceiver: (in > category 'debug support') ----- > - findSelectorOfMethod: meth forReceiver: rcvr > - > - | currClass classDict classDictSize methodArray i | > - (objectMemory addressCouldBeObj: meth) ifFalse: > - [^objectMemory nilObject]. > - (objectMemory addressCouldBeOop: rcvr) > - ifTrue: [currClass := objectMemory fetchClassOf: rcvr] > - ifFalse: [currClass := self methodClassOf: meth]. > - [classDict := objectMemory fetchPointer: MethodDictionaryIndex > ofObject: currClass. > - classDictSize := objectMemory fetchWordLengthOf: classDict. > - methodArray := objectMemory fetchPointer: MethodArrayIndex > ofObject: classDict. > - i := 0. > - [i <= (classDictSize - SelectorStart)] whileTrue: > - [meth = (objectMemory fetchPointer: i ofObject: > methodArray) ifTrue: > - [^(objectMemory fetchPointer: i + SelectorStart > ofObject: classDict)]. > - i := i + 1]. > - currClass := self superclassOf: currClass. > - currClass = objectMemory nilObject] whileFalse. > - ^currClass "method not found in superclass chain"! > > Item was changed: > ----- Method: > StackInterpreter>>printActivationNameFor:receiver:isBlock:firstTemporary: > (in category 'debug printing') ----- > printActivationNameFor: aMethod receiver: anObject isBlock: isBlock > firstTemporary: maybeMessage > + | methClass methodSel classObj | > - | methClass methodSel | > <inline: false> > isBlock ifTrue: > [self print: '[] in ']. > methClass := self findClassOfMethod: aMethod forReceiver: anObject. > + methodSel := self findSelectorOfMethod: aMethod. > + ((objectMemory addressCouldBeOop: anObject) > + and: [self addressCouldBeClassObj: (classObj := objectMemory > fetchClassOf: anObject)]) > - methodSel := self findSelectorOfMethod: aMethod forReceiver: > anObject. > - (objectMemory addressCouldBeOop: anObject) > ifTrue: > + [classObj = methClass > - [(objectMemory fetchClassOf: anObject) = methClass > ifTrue: [self printNameOfClass: methClass > count: 5] > ifFalse: > + [self printNameOfClass: classObj > count: 5. > - [self printNameOfClass: > (objectMemory fetchClassOf: anObject) count: 5. > self print: '('. > self printNameOfClass: methClass > count: 5. > self print: ')']] > ifFalse: [self print: 'INVALID RECEIVER']. > self print: '>'. > (objectMemory addressCouldBeOop: methodSel) > ifTrue: > [methodSel = objectMemory nilObject > ifTrue: [self print: '?'] > ifFalse: [self printStringOf: methodSel]] > ifFalse: [self print: 'INVALID SELECTOR']. > (methodSel = (objectMemory splObj: SelectorDoesNotUnderstand) > and: [(objectMemory addressCouldBeObj: maybeMessage) > and: [(objectMemory fetchClassOf: maybeMessage) = (objectMemory > splObj: ClassMessage)]]) ifTrue: > ["print arg message selector" > methodSel := objectMemory fetchPointer: > MessageSelectorIndex ofObject: maybeMessage. > self print: ' '. > self printStringOf: methodSel]! > > Item was changed: > ----- Method: StackInterpreter>>selectorOfContext: (in category 'debug > printing') ----- > selectorOfContext: aContext > (objectMemory isContext: aContext) ifFalse: > [^nil]. > + ^self findSelectorOfMethod: (objectMemory fetchPointer: > MethodIndex ofObject: aContext)! > - ^self > - findSelectorOfMethod: (objectMemory fetchPointer: > MethodIndex ofObject: aContext) > - forReceiver: (objectMemory fetchPointer: ReceiverIndex > ofObject: aContext)! > > -- best, Eliot

6 12

VMMaker-oscog issues on RISC OS
by tim Rowledge 14 Apr '13

14 Apr '13

I'm making a start at building the RISC OS StackVM and running into some fun problems. First one was the code in VMMaker class>generateConfiguration that builds directory names by means of evil URI related methods. Strange and ugly results occur for RISC OS and tracing the code reveals many strange and ugly things happening for every platform - it's just that on an OS where something like / is acceptable as a root directory it sort of ends up ok. RISC OS does not do that and I'm a little surprised that it doesn't cause problems on Windows too. My perfectly nice SDFS:RISCOSPi.$ root gets mangled to something like /SDFS%3ARISCOSPi%2F%2a/ or whatever. A simple fix for that is to change to "(FileDirectory default directoryNamed:'foo/bar') fullName" My next problem is that RISC OS must do the minor manglings seen in methods such as RiscOSVMMaker>export:forExternalPlugin: in order to get all its ducks in a row. Right now we have an explicit creation of a CrossPlatformVMMaker in the #createCodeGenerator method; I'll see if over-riding #forPlatform: will work. There simply isn't any way I can squeeze things within the constraints of the Cross way of making files for everything; RISC OS is just too different. In CCodeGenerator>generateInlineCppIfElse:asArgument:on:indent: we have" aStream ensureCr" which appears to upset a NullStream. Adding #ensureCr to the list in VMPluginCodeGenerator>emitCCodeOn:doInlining:doAssertions: gets us past that but I'm surprised it hasn't bitten people before. More news as it happens from the frontline of this spectacular battlefield engagement... tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Strange OpCodes: AII: Add Insult to Injury

5 10

VM Maker: VMMaker-dtl.319.mcz
by commits＠source.squeak.org 13 Apr '13

13 Apr '13

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.319.mcz ==================== Summary ==================== Name: VMMaker-dtl.319 Author: dtl Time: 13 April 2013, 4:03:18.985 pm UUID: d058d88c-331d-47ef-b178-fd26ca3de120 Ancestors: VMMaker-dtl.318 VMMaker 4.12.3 Fix errors in VMMaker-dtl.317 Move NewObjectMemory>>addressCouldBeObj: to ObjectMemory Use latest version of floatArg: with assertions removed. =============== Diff against VMMaker-dtl.318 =============== Item was changed: ----- Method: InterpreterPrimitives>>floatArg: (in category 'plugin primitive support') ----- floatArg: index "Like #stackFloatValue: but access method arguments left-to-right" + | oop | - | result oop | <returnTypeC: #double> - <var: #result type: #double> oop := self methodArg: index. oop = 0 ifTrue:[^0.0]. "methodArg: failed" + ^self floatValueOf: oop! - "N.B. Because Slang always inlines assertClassOf:is:compactClassIndex: - (because assertClassOf:is:compactClassIndex: has an inline: pragma) the - phrase (self splObj: ClassArray) is expanded in-place and is _not_ - evaluated if ClassArrayCompactIndex is non-zero." - self assertClassOf: oop is: (objectMemory splObj: ClassFloat) - compactClassIndex: ClassFloatCompactIndex. - self successful ifTrue: - [self cCode: '' inSmalltalk: [result := Float new: 2]. - objectMemory fetchFloatAt: oop + self baseHeaderSize into: result. - ^result]. - ^0.0! Item was removed: - ----- Method: NewObjectMemory>>addressCouldBeObj: (in category 'debug support') ----- - addressCouldBeObj: address - <api> - "Answer if address appears to be that of an object, which implies it is - safe to fetch the class and size. For code disassembly and assertions." - ^(address bitAnd: 3) = 0 - and: [address asUnsignedInteger >= self startOfMemory - and: [address asUnsignedInteger < freeStart - and: [(self headerType: address) ~= HeaderTypeGC]]]! Item was removed: - ----- Method: NewObjectMemory>>addressCouldBeObjWhileForwarding: (in category 'debug support') ----- - addressCouldBeObjWhileForwarding: address - "Answer if address appears to be that of an object, which implies it is - safe to fetch the class and size. For code disassembly and assertions." - ^(address bitAnd: 3) = 0 - and: [address asUnsignedInteger >= self startOfMemory - and: [address asUnsignedInteger < freeStart]]! Item was added: + ----- Method: ObjectMemory>>addressCouldBeObj: (in category 'debug support') ----- + addressCouldBeObj: address + <api> + "Answer if address appears to be that of an object, which implies it is + safe to fetch the class and size. For code disassembly and assertions." + ^(address bitAnd: 3) = 0 + and: [address asUnsignedInteger >= self startOfMemory + and: [address asUnsignedInteger < freeBlock + and: [(self headerType: address) ~= HeaderTypeGC]]]! Item was changed: ----- Method: VMMaker class>>versionString (in category 'version testing') ----- versionString "VMMaker versionString" + ^'4.12.3'! - ^'4.12.2'!

1 0

VM Maker: VMMaker-dtl.318.mcz
by commits＠source.squeak.org 13 Apr '13

13 Apr '13

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.318.mcz ==================== Summary ==================== Name: VMMaker-dtl.318 Author: dtl Time: 13 April 2013, 1:07:29.739 pm UUID: c46ff41d-870f-4bb1-b9b5-7b0064fc860c Ancestors: VMMaker-dtl.317 VMMaker 4.12.2 SocketPlugin fixes from VMMaker.oscog-eem.284 =============== Diff against VMMaker-dtl.317 =============== Item was changed: ----- Method: SocketPlugin>>primitiveSocket:getOptions: (in category 'primitives') ----- primitiveSocket: socket getOptions: optionName | s optionNameStart optionNameSize returnedValue errorCode results | + <var: #s type: #SocketPtr> + <var: #optionNameStart type: #'char *'> - <var: #s type: 'SocketPtr'> - <var: #optionNameStart type: 'char *'> self primitive: 'primitiveSocketGetOptions' parameters: #(Oop Oop). s := self socketValueOf: socket. interpreterProxy success: (interpreterProxy isBytes: optionName). + optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: #'char *'. - optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'. optionNameSize := interpreterProxy slotSizeOf: optionName. interpreterProxy failed ifTrue: [^nil]. returnedValue := 0. errorCode := self sqSocketGetOptions: s + optionNameStart: optionNameStart + optionNameSize: optionNameSize + returnedValue: (self addressOf: returnedValue). - optionNameStart: optionNameStart - optionNameSize: optionNameSize - returnedValue: (self cCode: '&returnedValue'). + results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. + interpreterProxy storePointer: 0 ofObject: results withValue: errorCode asSmallIntegerObj. + interpreterProxy storePointer: 1 ofObject: results withValue: returnedValue asSmallIntegerObj. - interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj. - interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj. - interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2). - results := interpreterProxy popRemappableOop. - interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop. - interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop. ^ results! Item was changed: ----- Method: SocketPlugin>>primitiveSocket:receiveUDPDataBuf:start:count: (in category 'primitives') ----- primitiveSocket: socket receiveUDPDataBuf: array start: startIndex count: count + | s elementSize arrayBase bufStart bytesReceived results address port moreFlag | + <var: #s type: #SocketPtr> + <var: #arrayBase type: #'char *'> + <var: #bufStart type: #'char *'> - | s byteSize arrayBase bufStart bytesReceived results address port moreFlag | - <var: #s type: 'SocketPtr'> - <var: #arrayBase type: 'char *'> - <var: #bufStart type: 'char *'> self primitive: 'primitiveSocketReceiveUDPDataBufCount' + parameters: #(Oop Oop SmallInteger SmallInteger). - parameters: #(Oop Oop SmallInteger SmallInteger ). s := self socketValueOf: socket. "buffer can be any indexable words or bytes object" interpreterProxy success: (interpreterProxy isWordsOrBytes: array). (interpreterProxy isWords: array) + ifTrue: [elementSize := 4] + ifFalse: [elementSize := 1]. - ifTrue: [byteSize := 4] - ifFalse: [byteSize := 1]. interpreterProxy success: (startIndex >= 1 and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]). interpreterProxy failed ifFalse: ["Note: adjust bufStart for zero-origin indexing" + arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *'. + bufStart := arrayBase + (startIndex - 1 * elementSize). + address := 0. + port := 0. + moreFlag := 0. + bytesReceived := self sqSocket: s + ReceiveUDPDataBuf: bufStart + Count: count * elementSize + address: (self addressOf: address) + port: (self addressOf: port) + moreFlag: (self addressOf: moreFlag). + - arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'. - bufStart := arrayBase + (startIndex - 1 * byteSize). "allocate storage for results, remapping newly allocated oops in case GC happens during allocation" - address := 0. - port := 0. - moreFlag := 0. - bytesReceived := self - sqSocket: s - ReceiveUDPDataBuf: bufStart - Count: count * byteSize - address: (self cCode: '&address') - port: (self cCode: '&port') - moreFlag: (self cCode: '&moreFlag'). - - interpreterProxy pushRemappableOop: port asSmallIntegerObj. interpreterProxy pushRemappableOop: (self intToNetAddress: address). + results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 4. + interpreterProxy storePointer: 0 ofObject: results withValue: (bytesReceived // elementSize) asSmallIntegerObj. - interpreterProxy pushRemappableOop: (bytesReceived // byteSize) asSmallIntegerObj. - interpreterProxy pushRemappableOop: - (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 4). - results := interpreterProxy popRemappableOop. - interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop. interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop. + interpreterProxy storePointer: 2 ofObject: results withValue: port asSmallIntegerObj. + interpreterProxy storePointer: 3 ofObject: results withValue: (moreFlag + ifTrue: [interpreterProxy trueObject] + ifFalse: [interpreterProxy falseObject]). - interpreterProxy storePointer: 2 ofObject: results withValue: interpreterProxy popRemappableOop. - moreFlag - ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ] - ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ]. ]. ^ results! Item was changed: ----- Method: SocketPlugin>>primitiveSocket:setOptions:value: (in category 'primitives') ----- primitiveSocket: socket setOptions: optionName value: optionValue + "THIS BADLY NEEDS TO BE REWRITTEN TO TAKE Booleans AND Integers AS WELL AS (OR INSTEAD OF) Strings. + It is only used with booleans and integers and parsing these back out of strings in + sqSocketSetOptions:optionNameStart:optionNameSize:optionValueStart:optionValueSize:returnedValue: + is STUPID." - | s optionNameStart optionNameSize optionValueStart optionValueSize returnedValue errorCode results | + <var: #s type: #SocketPtr> + <var: #optionNameStart type: #'char *'> + <var: #optionValueStart type: #'char *'> - <var: #s type: 'SocketPtr'> - <var: #optionNameStart type: 'char *'> - <var: #optionValueStart type: 'char *'> self primitive: 'primitiveSocketSetOptions' parameters: #(Oop Oop Oop). s := self socketValueOf: socket. interpreterProxy success: (interpreterProxy isBytes: optionName). + optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: #'char *'. - optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'. optionNameSize := interpreterProxy slotSizeOf: optionName. interpreterProxy success: (interpreterProxy isBytes: optionValue). + optionValueStart:= self cCoerce: (interpreterProxy firstIndexableField: optionValue) to: #'char *'. - optionValueStart:= self cCoerce: (interpreterProxy firstIndexableField: optionValue) to: 'char *'. optionValueSize := interpreterProxy slotSizeOf: optionValue. interpreterProxy failed ifTrue: [^nil]. returnedValue := 0. errorCode := self sqSocketSetOptions: s + optionNameStart: optionNameStart + optionNameSize: optionNameSize + optionValueStart: optionValueStart + optionValueSize: optionValueSize + returnedValue: (self addressOf: returnedValue). - optionNameStart: optionNameStart - optionNameSize: optionNameSize - optionValueStart: optionValueStart - optionValueSize: optionValueSize - returnedValue: (self cCode: '&returnedValue'). + results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. + interpreterProxy storePointer: 0 ofObject: results withValue: errorCode asSmallIntegerObj. + interpreterProxy storePointer: 1 ofObject: results withValue: returnedValue asSmallIntegerObj. - interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj. - interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj. - interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2). - results := interpreterProxy popRemappableOop. - interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop. - interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop. ^ results! Item was changed: ----- Method: VMMaker class>>versionString (in category 'version testing') ----- versionString "VMMaker versionString" + ^'4.12.2'! - ^'4.12.1'!

1 0

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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev April 2013