[Vm-dev] VM Maker: VMMaker-oscog-EstebanLorenzano.237.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Apr 16 14:38:56 UTC 2013
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 at 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!
More information about the Vm-dev
mailing list