[Vm-dev] VM Maker: VMMaker.oscog-eem.3172.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Feb 26 03:00:23 UTC 2022
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3172.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3172
Author: eem
Time: 25 February 2022, 7:00:13.958638 pm
UUID: 179d469e-5dc1-4805-b9a7-82f65dfdef00
Ancestors: VMMaker.oscog-eem.3171
Eliminate several incompatible pointer warings.
Access CogStackPages>>bytesPerPage directly for vmParameterAt:
=============== Diff against VMMaker.oscog-eem.3171 ===============
Item was added:
+ ----- Method: CCodeGenerator>>generateAsWideString:on:indent: (in category 'C translation') -----
+ generateAsWideString: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream.
+ The receiver is expected to be a TConstantNode."
+
+ aStream nextPut: $L; nextPutAll: (self cLiteralFor: msgNode receiver nameOrValue)!
Item was changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
translationDict := Dictionary new: 200.
pairs := #(
#& #generateAnd:on:indent:
#| #generateOr:on:indent:
#abs #generateAbs:on:indent:
#and: #generateSequentialAnd:on:indent:
#or: #generateSequentialOr:on:indent:
#not #generateNot:on:indent:
#+ #generatePlus:on:indent:
#- #generateMinus:on:indent:
#negated #generateNegated:on:indent:
#* #generateTimes:on:indent:
#/ #generateDivide:on:indent:
#// #generateDivide:on:indent:
#\\ #generateModulo:on:indent:
#<< #generateShiftLeft:on:indent:
#>> #generateShiftRight:on:indent:
#>>> #generateSignedShiftRight:on:indent:
#, #generateComma:on:indent:
#min: #generateMin:on:indent:
#max: #generateMax:on:indent:
#between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent:
#bitOr: #generateBitOr:on:indent:
#bitXor: #generateBitXor:on:indent:
#bitShift: #generateBitShift:on:indent:
#signedBitShift: #generateSignedBitShift:on:indent:
#bitInvert #generateBitInvert:on:indent:
#bitInvert32 #generateBitInvert:on:indent:
#bitInvert64 #generateBitInvert:on:indent:
#bitClear: #generateBitClear:on:indent:
#truncateTo: #generateTruncateTo:on:indent:
#rounded #generateRounded:on:indent:
#even #generateEven:on:indent:
#odd #generateOdd:on:indent:
#byteSwap32 #generateByteSwap32:on:indent:
#byteSwap64 #generateByteSwap64:on:indent:
#byteSwapped32IfBigEndian: generateByteSwap32IfBigEndian:on:indent:
#byteSwapped64IfBigEndian: generateByteSwap64IfBigEndian:on:indent:
#< #generateLessThan:on:indent:
#<= #generateLessThanOrEqual:on:indent:
#= #generateEqual:on:indent:
#> #generateGreaterThan:on:indent:
#>= #generateGreaterThanOrEqual:on:indent:
#~= #generateNotEqual:on:indent:
#== #generateEqual:on:indent:
#~~ #generateNotEqual:on:indent:
#isNil #generateIsNil:on:indent:
#notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent:
#whileFalse: #generateWhileFalse:on:indent:
#whileTrue #generateDoWhileTrue:on:indent:
#whileFalse #generateDoWhileFalse:on:indent:
#to:do: #generateToDo:on:indent:
#to:by:do: #generateToByDo:on:indent:
#repeat #generateRepeat:on:indent:
#timesRepeat: #generateTimesRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent:
#ifFalse: #generateIfFalse:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#ifNotNil: #generateIfNotNil:on:indent:
#ifNil: #generateIfNil:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent:
#at: #generateAt:on:indent:
#at:put: #generateAtPut:on:indent:
#basicAt: #generateAt:on:indent:
#basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent:
#integerObjectOf: #generateIntegerObjectOf:on:indent:
#isIntegerObject: #generateIsIntegerObject:on:indent:
#cCode: #generateInlineCCode:on:indent:
#cCode:inSmalltalk: #generateInlineCCode:on:indent:
#cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cppIf:ifTrue:cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElse:on:indent:
#cppIf:ifFalse: #generateInlineCppIfElse:on:indent:
#cCoerce:to: #generateCCoercion:on:indent:
#cCoerceSimple:to: #generateCCoercion:on:indent:
#addressOf: #generateAddressOf:on:indent:
#addressOf:put: #generateAddressOf:on:indent:
#asAddress:put: #generateAsAddress:on:indent:
#signedIntFromLong64 #generateSignedIntFromLong64:on:indent:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort:on:indent:
#signedIntToLong64 #generateSignedIntToLong64:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntToShort #generateSignedIntToShort:on:indent:
#preIncrement #generatePreIncrement:on:indent:
#preDecrement #generatePreDecrement:on:indent:
#inline: #generateInlineDirective:on:indent:
#asFloat #generateAsFloat:on:indent:
#asInteger #generateAsInteger:on:indent:
#asIntegerPtr #generateAsIntegerPtr:on:indent:
#asUnsignedInteger #generateAsUnsignedInteger:on:indent:
#asUnsignedIntegerPtr #generateAsUnsignedIntegerPtr:on:indent:
#asLong #generateAsLong:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
#asUnsignedLongLong #generateAsUnsignedLongLong:on:indent:
#asVoidPointer #generateAsVoidPointer:on:indent:
#asSymbol #generateAsSymbol:on:indent:
+ #asWideString #generateAsWideString:on:indent:
#flag: #generateFlag:on:indent:
#anyMask: #generateAnyMask:on:indent:
#allMask: #generateAllMask:on:indent:
#noMask: #generateNoMask:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:
#bytesPerOop #generateBytesPerOop:on:indent:
#bytesPerWord #generateBytesPerWord:on:indent:
#wordSize #generateBytesPerWord:on:indent:
#baseHeaderSize #generateBaseHeaderSize:on:indent:
#minSmallInteger #generateSmallIntegerConstant:on:indent:
#maxSmallInteger #generateSmallIntegerConstant:on:indent:
#sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
#perform: #generatePerform:on:indent:
#perform:with: #generatePerform:on:indent:
#perform:with:with: #generatePerform:on:indent:
#perform:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent:
#value: #generateValue:on:indent:
#value:value: #generateValue:on:indent:
#value:value:value: #generateValue:on:indent:
#value:value:value:value: #generateValue:on:indent:
#value:value:value:value:value: #generateValue:on:indent:
#value:value:value:value:value:value: #generateValue:on:indent:
#deny: #generateDeny:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #generateSmalltalkMetaError:on:indent:
#subclassResponsibility #generateSmalltalkMetaError:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #(
#ifTrue: #generateIfTrueAsArgument:on:indent:
#ifFalse: #generateIfFalseAsArgument:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
#ifNotNil: #generateIfNotNilAsArgument:on:indent:
#ifNil: #generateIfNilAsArgument:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent:
#cCode: #generateInlineCCodeAsArgument:on:indent:
#cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent:
#value #generateValueAsArgument:on:indent:
#value: #generateValueAsArgument:on:indent:
#value:value: #generateValueAsArgument:on:indent:
).
asArgumentTranslationDict := Dictionary new: 8.
1 to: pairs size by: 2 do: [:i |
asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
Item was changed:
----- Method: CoInterpreter>>methodCacheAddress (in category 'cog jit support') -----
methodCacheAddress
<api>
+ <returnTypeC: #usqInt>
+ ^self cCode: [methodCache asUnsignedInteger] inSmalltalk: [methodCache address]!
- <returnTypeC: #'void *'>
- ^self cCode: [methodCache] inSmalltalk: [methodCache address]!
Item was changed:
----- Method: CoInterpreter>>reloadPrimitiveCalloutPointer (in category 'plugin primitive support') -----
reloadPrimitiveCalloutPointer
<inline: #never>
| index |
+ <var: 'moduleName' type: #'char *'>
super reloadPrimitiveCalloutPointer.
"Find out whether SqueakFFIPrims is internal or external"
primCalloutIsExternal := true.
index := 1.
[(self ioListBuiltinModule: index)
ifNil: [^self]
ifNotNil:
[:moduleName|
(self strcmp: moduleName _: 'SqueakFFIPrims') = 0 ifTrue:
[primCalloutIsExternal := false]].
index := index + 1.
true] whileTrue!
Item was changed:
----- Method: CogIA32Compiler>>stopsFrom:to: (in category 'generate machine code - support') -----
stopsFrom: startAddr to: endAddr
self
+ cCode: [self memset: startAddr asVoidPointer _: self stop _: endAddr - startAddr + 1]
- cCode: [self memset: startAddr _: self stop _: endAddr - startAddr + 1]
inSmalltalk:
[| alignedEnd alignedStart stops |
stops := self stop << 8 + self stop.
stops := stops << 16 + stops.
alignedStart := startAddr + 3 // 4 * 4.
alignedEnd := endAddr - 1 // 4 * 4.
alignedEnd <= startAddr
ifTrue:
[startAddr to: endAddr do:
[:addr | cogit codeByteAt: addr put: self stop]]
ifFalse:
[startAddr to: alignedStart - 1 do:
[:addr | cogit codeByteAt: addr put: self stop].
alignedStart to: alignedEnd by: 4 do:
[:addr | cogit codeLong32At: addr put: stops].
alignedEnd + 4 to: endAddr do:
[:addr | cogit codeByteAt: addr put: self stop]]]!
Item was changed:
----- Method: CogInLineLiteralsX64Compiler>>inlineCacheTagAt: (in category 'inline cacheing') -----
inlineCacheTagAt: callSiteReturnAddress
"Answer the inline cache tag for the return address of a send."
+ <inline: true>
+ ^self literal32BeforeFollowingAddress: (callSiteReturnAddress - 5) asUnsignedInteger!
- ^self literal32BeforeFollowingAddress: callSiteReturnAddress - 5!
Item was added:
+ ----- Method: CogStackPages>>bytesPerPage (in category 'accessing') -----
+ bytesPerPage
+ ^bytesPerPage!
Item was changed:
----- Method: CogX64Compiler>>stopsFrom:to: (in category 'generate machine code - support') -----
stopsFrom: startAddr to: endAddr
self
+ cCode: [self memset: startAddr asVoidPointer _: self stop _: endAddr - startAddr + 1]
- cCode: [self memset: startAddr _: self stop _: endAddr - startAddr + 1]
inSmalltalk:
[| alignedEnd alignedStart stops |
stops := self stop << 8 + self stop.
stops := stops << 16 + stops.
stops := stops << 32 + stops.
alignedStart := startAddr + 7 // 8 * 8.
alignedEnd := endAddr - 1 // 8 * 8.
alignedEnd <= startAddr
ifTrue:
[startAddr to: endAddr do:
[:addr | cogit codeByteAt: addr put: self stop]]
ifFalse:
[startAddr to: alignedStart - 1 do:
[:addr | cogit codeByteAt: addr put: self stop].
alignedStart to: alignedEnd by: 8 do:
[:addr | cogit codeLong64At: addr put: stops].
alignedEnd + 8 to: endAddr do:
[:addr | cogit codeByteAt: addr put: self stop]]]!
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"
- "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"
self primitive: 'primitiveShowHostWindowRect'
parameters: #(SmallInteger WordArray SmallInteger SmallInteger SmallInteger
+ SmallInteger 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"
+ (self ioShowDisplayOnWindow: (self cCoerceSimple: dispBits to: #'unsigned char *')
+ _: w
+ _: h
+ _: d
+ _: left
+ _: right
+ _: top
+ _: bottom
+ _: windowIndex) ifFalse:
- ioShowDisplay with the extra parameter of the windowIndex integer"
- (self ioShowDisplayOnWindow: dispBits _: w _: h _: d _: left _: right _: top _: bottom _: windowIndex) ifFalse:
[interpreterProxy primitiveFail]!
Item was changed:
----- Method: IA32ABIPlugin>>primDoubleAt (in category 'primitives-accessing') -----
primDoubleAt
"Answer the 64-bit double starting at the given byte offset (little endian)."
"<Alien> doubleAt: index <Integer> ^<Float>
<primitive: 'primDoubleAt' error: errorCode module: 'IA32ABI'>"
+ | byteOffset rcvr startAddr floatValue |
- | byteOffset rcvr startAddr addr floatValue |
<export: true>
<var: #floatValue type: #double>
byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self index: byteOffset length: 8 inRange: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
(startAddr := self startOfData: rcvr) = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ self memcpy: (self addressOf: floatValue put: [:v| floatValue := v]) _: (startAddr + byteOffset) asVoidPointer _: (self sizeof: floatValue).
- addr := startAddr + byteOffset.
- self memcpy: (self addressOf: floatValue put: [:v| floatValue := v]) _: addr _: (self sizeof: floatValue).
interpreterProxy methodReturnFloat: floatValue!
Item was changed:
----- Method: IA32ABIPlugin>>primDoubleAtPut (in category 'primitives-accessing') -----
primDoubleAtPut
"Store a double into 64 bits starting at the given byte offset (little endian)."
"<Alien> doubleAt: index <Integer> put: value <Float | Integer> ^<Float | Integer>
<primitive: 'primDoubleAtPut' error: errorCode module: 'IA32ABI'>"
+ | byteOffset rcvr startAddr valueOop floatValue |
- | byteOffset rcvr startAddr addr valueOop floatValue |
<export: true>
<var: #floatValue type: #double>
valueOop := interpreterProxy stackValue: 0.
(interpreterProxy isIntegerObject: valueOop)
ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double]
ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double].
byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
rcvr := interpreterProxy stackObjectValue: 2.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self index: byteOffset length: 8 inRange: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
(interpreterProxy isOopImmutable: rcvr) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
(startAddr := self startOfData: rcvr) = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ self memcpy: (startAddr + byteOffset) asVoidPointer _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- addr := startAddr + byteOffset.
- self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
interpreterProxy methodReturnValue: valueOop!
Item was changed:
----- Method: IA32ABIPlugin>>primFloatAt (in category 'primitives-accessing') -----
primFloatAt
"Answer the 32-bit float starting at the given byte offset (little endian)."
"<Alien> floatAt: index <Integer> ^<Float>
<primitive: 'primFloatAt' error: errorCode module: 'IA32ABI'>"
+ | byteOffset rcvr startAddr floatValue |
- | byteOffset rcvr startAddr addr floatValue |
<export: true>
<var: #floatValue type: #float>
byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self index: byteOffset length: 4 inRange: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
(startAddr := self startOfData: rcvr) = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ self memcpy: (self addressOf: floatValue put: [:v| floatValue := v]) _: (startAddr + byteOffset) asVoidPointer _: (self sizeof: floatValue).
- addr := startAddr + byteOffset.
- self memcpy: (self addressOf: floatValue put: [:v| floatValue := v]) _: addr _: (self sizeof: floatValue).
interpreterProxy methodReturnFloat: floatValue!
Item was changed:
----- Method: IA32ABIPlugin>>primFloatAtPut (in category 'primitives-accessing') -----
primFloatAtPut
"Store a float into 32 bits starting at the given byte offset (little endian)."
"<Alien> floatAt: index <Integer> put: value <Float | Integer> ^<Float | Integer>
<primitive: 'primFloatAtPut' error: errorCode module: 'IA32ABI'>"
+ | byteOffset rcvr startAddr valueOop floatValue |
- | byteOffset rcvr startAddr addr valueOop floatValue |
<export: true>
<var: #floatValue type: #float>
valueOop := interpreterProxy stackValue: 0.
(interpreterProxy isIntegerObject: valueOop)
ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double]
ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double].
byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
rcvr := interpreterProxy stackObjectValue: 2.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self index: byteOffset length: 4 inRange: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
(interpreterProxy isOopImmutable: rcvr) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
(startAddr := self startOfData: rcvr) = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ self memcpy: (startAddr + byteOffset) asVoidPointer _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- addr := startAddr + byteOffset.
- self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
interpreterProxy methodReturnValue: valueOop!
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'>"
<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 * interpreterProxy bytesPerOop)
and: [interpreterProxy isBytes: functionName]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
address := interpreterProxy
ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: functionName)
to: #sqInt)
OfLength: (interpreterProxy byteSizeOf: functionName)
+ FromModule: (self longAt: libraryProxy + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop) asVoidPointer.
- FromModule: (self longAt: libraryProxy + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop).
(interpreterProxy failed
or: [address = 0]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNotFound].
interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: address asUnsignedInteger)!
Item was changed:
----- Method: IA32ABIPlugin>>primMostRecentCallbackContext (in category 'primitives-callbacks') -----
primMostRecentCallbackContext
"This is here only for debugging; it is really useful in predicting the behaviour of primReturnAsFromContextThrough."
<export: true>
+ interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: self getMostRecentCallbackContext asUnsignedInteger)!
- interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: self getMostRecentCallbackContext)!
Item was changed:
----- Method: ObjectMemory>>printStringDataOf:on: (in category 'debug printing interpreter support') -----
printStringDataOf: oop on: aStream
<var: 'aStream' type: #'FILE *'>
| i n limit |
<var: 'buffer' type: #'char *'>
<var: 'wideBuffer' type: #'unsigned int *'>
(self isBytesNonImm: oop)
ifTrue:
[| buffer byte |
buffer := self alloca: 256 * 4.
n := i := 0.
limit := (self numBytesOfBytes: oop) min: 256.
[i < limit] whileTrue:
[byte := self fetchByte: i ofObject: oop.
i := i + 1.
(byte < 32 "space" and: [byte ~= 9 "tab"])
ifTrue:
[buffer at: n put: $<. n := n + 1.
(byte = 10 or: [byte = 13])
ifTrue:
[byte = 10
ifTrue: [buffer at: n put: $L; at: n + 1 put: $F]
ifFalse: [buffer at: n put: $C; at: n + 1 put: $R].
n := n + 2]
ifFalse:
[byte >= 10 ifTrue:
[buffer at: n put: byte // 10 + $0 asInteger. n := n + 1].
buffer at: n put: byte \\ 10 + $0 asInteger. n := n + 1].
buffer at: n put: $>. n := n + 1]
ifFalse: [buffer at: n put: byte. n := n + 1]].
'%.*s%s\n' f: aStream printf: { n. buffer. (self numBytesOfBytes: oop) > limit ifTrue: ['...'] ifFalse: [''] }]
ifFalse:
[| wideBuffer word |
self assert: (self isWordsNonImm: oop).
wideBuffer := self cCoerce: (self alloca: 1024 * 4) to: 'int *'.
n := i := 0.
limit := (self lengthOf: oop) min: 256.
[i < limit] whileTrue:
[word := self fetchLong32: i ofObject: oop.
i := i + 1.
(word < 32 "space" and: [word ~= 9 "tab"])
ifTrue:
[wideBuffer at: n put: $<. n := n + 1.
(word = 10 or: [word = 13])
ifTrue:
[word = 10
ifTrue: [wideBuffer at: n put: $L; at: n + 1 put: $F]
ifFalse: [wideBuffer at: n put: $C; at: n + 1 put: $R].
n := n + 2]
ifFalse:
[word >= 10 ifTrue:
[wideBuffer at: n put: word // 10 + $0 asInteger. n := n + 1].
wideBuffer at: n put: word \\ 10 + $0 asInteger. n := n + 1].
wideBuffer at: n put: $>. n := n + 1]
ifFalse: [wideBuffer at: n put: word. n := n + 1]].
+ '%.*s%s\n' asWideString f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!
- '%.*s%s\n' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
compileOpenPIC: selector numArgs: numArgs
"Compile the code for an open PIC. Perform a probe of the first-level method
lookup cache followed by a call of ceSendFromInLineCacheMiss: if the probe fails."
| cacheBaseReg jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod |
<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
<var: #jumpClassMiss type: #'AbstractInstruction *'>
<var: #itsAHit type: #'AbstractInstruction *'>
<var: #jumpBCMethod type: #'AbstractInstruction *'>
self preenMethodLabel.
self compilePICAbort: numArgs.
entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: SendNumArgsReg scratchReg: TempReg.
self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
cacheBaseReg := NoReg.
(backEnd isWithinMwOffsetRange: coInterpreter methodCacheAddress) ifFalse:
[self MoveCq: coInterpreter methodCacheAddress R: (cacheBaseReg := Extra0Reg)].
"Do first of three probes. See CoInterpreter>>lookupInMethodCacheSel:classTag:"
jumpSelectorMiss := self compileOpenPICMethodCacheProbeFor: selector withShift: 0 baseRegOrNone: cacheBaseReg.
jumpClassMiss := self JumpNonZero: 0.
"Fetch the method. The interpret trampoline requires the bytecoded method in SendNumArgsReg"
itsAHit := self MoveMw: (cacheBaseReg = NoReg
+ ifTrue: [coInterpreter methodCacheAddress + (MethodCacheMethod << objectMemory shiftForWord)]
- ifTrue: [coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << objectMemory shiftForWord)]
ifFalse: [MethodCacheMethod << objectMemory shiftForWord])
r: ClassReg
R: SendNumArgsReg.
.
"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
jumpBCMethod jmpTarget: picInterpretAbort.
self AddCq: cmNoCheckEntryOffset R: ClassReg.
self JumpR: ClassReg.
"First probe missed. Do second of three probes. Shift hash right one and retry."
jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
jumpSelectorMiss := self compileOpenPICMethodCacheProbeFor: selector withShift: 1 baseRegOrNone: cacheBaseReg.
self JumpZero: itsAHit.
"Second probe missed. Do last probe. Shift hash right two and retry."
jumpSelectorMiss jmpTarget: self Label.
jumpSelectorMiss := self compileOpenPICMethodCacheProbeFor: selector withShift: 2 baseRegOrNone: cacheBaseReg.
self JumpZero: itsAHit.
"Last probe missed. Call ceSendFromInLineCacheMiss: to do the full lookup."
jumpSelectorMiss jmpTarget: self Label.
self numRegArgs > 0 ifTrue:
[backEnd genPushRegisterArgsForNumArgs: numArgs scratchReg: SendNumArgsReg].
self genSmalltalkToCStackSwitch: true.
methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
self
compileCallFor: #ceSendFromInLineCacheMiss:
numArgs: 1
arg: SendNumArgsReg
arg: nil
arg: nil
arg: nil
resultReg: NoReg
regsToSave: self emptyRegisterMask
"Note that this call does not return."!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileOpenPICMethodCacheProbeFor:withShift:baseRegOrNone: (in category 'in-line cacheing') -----
compileOpenPICMethodCacheProbeFor: selector withShift: shift baseRegOrNone: baseRegOrNone
"Compile one method cache probe in an OpenPIC's lookup of selector.
Answer the jump taken if the selector probe fails.
The class tag of the receiver must be in SendNumArgsReg. ClassReg and TempReg are used as scratch registers.
On a hit, the offset of the entry is in ClassReg."
<returnTypeC: #'AbstractInstruction *'>
<inline: false>
| jumpSelectorMiss |
<var: 'jumpSelectorMiss' type: #'AbstractInstruction *'>
self MoveR: SendNumArgsReg R: ClassReg.
objectRepresentation maybeShiftClassTagRegisterForMethodCacheProbe: ClassReg.
self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
self assert: shift <= objectMemory shiftForWord.
"Need to shift the hash right by shift to form the probe, and then shift the probe left by shiftForWord to form the index.
So shift left by shiftForWord - shift and and with the shifted mask."
shift < objectMemory shiftForWord ifTrue:
[self LogicalShiftLeftCq: objectMemory shiftForWord - shift R: ClassReg].
self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
baseRegOrNone = NoReg
ifTrue:
+ [self MoveMw: coInterpreter methodCacheAddress + (MethodCacheSelector << objectMemory shiftForWord)
- [self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
r: ClassReg
R: TempReg]
ifFalse:
[self AddR: baseRegOrNone R: ClassReg;
MoveMw: MethodCacheSelector << objectMemory shiftForWord r: ClassReg R: TempReg].
self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
jumpSelectorMiss := self JumpNonZero: 0.
baseRegOrNone = NoReg
ifTrue:
+ [self MoveMw: coInterpreter methodCacheAddress + (MethodCacheClass << objectMemory shiftForWord)
- [self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
r: ClassReg
R: TempReg]
ifFalse:
[self MoveMw: MethodCacheClass << objectMemory shiftForWord r: ClassReg R: TempReg].
self CmpR: SendNumArgsReg R: TempReg.
^jumpSelectorMiss!
Item was changed:
----- Method: SimpleStackBasedCogit>>compilePerformMethodCacheProbeFor:withShift:baseRegOrNone: (in category 'in-line cacheing') -----
compilePerformMethodCacheProbeFor: selectorReg withShift: shift baseRegOrNone: baseRegOrNone
"Compile one method cache probe in a perform: primitive's lookup of selector.
Answer the jump taken if the selector probe fails."
<returnTypeC: #'AbstractInstruction *'>
<inline: false>
| jumpSelectorMiss |
<var: 'jumpSelectorMiss' type: #'AbstractInstruction *'>
self MoveR: SendNumArgsReg R: ClassReg.
objectRepresentation maybeShiftClassTagRegisterForMethodCacheProbe: ClassReg.
self XorR: selectorReg R: ClassReg.
self assert: shift <= objectMemory shiftForWord.
"Need to shift the hash right by shift to form the probe, and then shift the probe left by shiftForWord to form the index.
So shift left by shiftForWord - shift and and with the shifted mask."
shift < objectMemory shiftForWord ifTrue:
[self LogicalShiftLeftCq: objectMemory shiftForWord - shift R: ClassReg].
self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
baseRegOrNone = NoReg
ifTrue:
+ [self MoveMw: coInterpreter methodCacheAddress + (MethodCacheSelector << objectMemory shiftForWord)
- [self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
r: ClassReg
R: TempReg]
ifFalse:
[self AddR: baseRegOrNone R: ClassReg;
MoveMw: MethodCacheSelector << objectMemory shiftForWord r: ClassReg R: TempReg].
self CmpR: selectorReg R: TempReg.
jumpSelectorMiss := self JumpNonZero: 0.
baseRegOrNone = NoReg
ifTrue:
+ [self MoveMw: coInterpreter methodCacheAddress + (MethodCacheClass << objectMemory shiftForWord)
- [self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
r: ClassReg
R: TempReg]
ifFalse:
[self MoveMw: MethodCacheClass << objectMemory shiftForWord r: ClassReg R: TempReg].
self CmpR: SendNumArgsReg R: TempReg.
^jumpSelectorMiss!
Item was changed:
----- Method: SimpleStackBasedCogit>>genLookupForPerformNumArgs: (in category 'primitive generators') -----
genLookupForPerformNumArgs: numArgs
"Compile the code for a probe of the first-level method cache for a perform primitive.
The selector is assumed to be in Arg0Reg. Defer to adjustArgumentsForPerform: to
adjust the arguments before the jump to the method."
| jumpSelectorMiss jumpClassMiss jumpInterpret itsAHit cacheBaseReg |
<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
<var: #jumpClassMiss type: #'AbstractInstruction *'>
<var: #jumpInterpret type: #'AbstractInstruction *'>
<var: #itsAHit type: #'AbstractInstruction *'>
"N.B. Can't assume TempReg already contains the tag because a method can
of course be invoked via the unchecked entry-point, e.g. as does perform:."
objectRepresentation genGetInlineCacheClassTagFrom: ReceiverResultReg into: SendNumArgsReg forEntry: false.
self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
cacheBaseReg := NoReg.
(backEnd isWithinMwOffsetRange: coInterpreter methodCacheAddress) ifFalse:
[self MoveCq: coInterpreter methodCacheAddress R: (cacheBaseReg := Extra0Reg)].
"Do first of three probes. See CoInterpreter>>lookupInMethodCacheSel:classTag:"
jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 0 baseRegOrNone: cacheBaseReg.
jumpClassMiss := self JumpNonZero: 0.
"Fetch the method, and check if it is cogged."
itsAHit := self MoveMw: (cacheBaseReg = NoReg
+ ifTrue: [coInterpreter methodCacheAddress + (MethodCacheMethod << objectMemory shiftForWord)]
- ifTrue: [coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << objectMemory shiftForWord)]
ifFalse: [MethodCacheMethod << objectMemory shiftForWord])
r: ClassReg
R: SendNumArgsReg.
"If the method is not compiled fall back on the interpreter primitive."
objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
jumpInterpret := objectRepresentation genJumpImmediate: ClassReg.
"Adjust arguments and jump to the method's unchecked entry-point."
self AddCq: cmNoCheckEntryOffset R: ClassReg.
self adjustArgumentsForPerform: numArgs.
self JumpR: ClassReg.
"First probe missed. Do second of three probes. Shift hash right one and retry."
jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 1 baseRegOrNone: cacheBaseReg.
self JumpZero: itsAHit.
"Second probe missed. Do last probe. Shift hash right two and retry."
jumpSelectorMiss jmpTarget: self Label.
jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 2 baseRegOrNone: cacheBaseReg.
self JumpZero: itsAHit.
"Last probe missed. Caller will generate the call to fall back on the interpreter primitive."
jumpSelectorMiss jmpTarget:
(jumpInterpret jmpTarget: self Label).
^0!
Item was changed:
----- Method: SpurMemoryManager>>printFreeChunk:printAsTreeNode: (in category 'debug printing') -----
printFreeChunk: freeChunk printAsTreeNode: printAsTreeNode
| numBytes |
numBytes := self bytesInBody: freeChunk.
coInterpreter
+ print: 'freeChunk '; printHexnp: freeChunk.
- print: 'freeChunk '; printHexPtrnp: freeChunk.
printAsTreeNode ifTrue:
[coInterpreter
print: ((freeChunk = (freeLists at: 0)) ifTrue: [' + '] ifFalse: [' - ']);
+ printHexnp:(self addressAfter: freeChunk)].
- printHexPtrnp:(self addressAfter: freeChunk)].
coInterpreter
print: ' bytes '; printNum: numBytes;
+ print: ' next '; printHexnp: (self fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: freeChunk).
- print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: freeChunk).
(self isLilliputianSize: numBytes) ifFalse:
[coInterpreter
+ print: ' prev '; printHexnp: (self fetchPointer: self freeChunkPrevIndex
- print: ' prev '; printHexPtrnp: (self fetchPointer: self freeChunkPrevIndex
ofFreeChunk: freeChunk).].
(numBytes >= (self numFreeLists * self allocationUnit)
and: [printAsTreeNode]) ifTrue:
[coInterpreter
+ print: ' ^ '; printHexnp: (self fetchPointer: self freeChunkParentIndex
- print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
ofFreeChunk: freeChunk);
+ print: ' < '; printHexnp: (self fetchPointer: self freeChunkSmallerIndex
- print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
ofFreeChunk: freeChunk);
+ print: ' > '; printHexnp: (self fetchPointer: self freeChunkLargerIndex
- print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
ofFreeChunk: freeChunk)].
coInterpreter cr!
Item was changed:
----- Method: SpurMemoryManager>>printStringDataOf:on: (in category 'debug printing interpreter support') -----
printStringDataOf: oop on: aStream
<var: 'aStream' type: #'FILE *'>
| i n limit |
<var: 'buffer' type: #'char *'>
<var: 'wideBuffer' type: #'unsigned int *'>
(self isBytesNonImm: oop)
ifTrue:
[| buffer byte |
buffer := self alloca: 256 * 4.
n := i := 0.
limit := (self numBytesOfBytes: oop) min: 256.
[n < limit] whileTrue:
[byte := self fetchByte: i ofObject: oop.
i := i + 1.
(byte < 32 "space" and: [byte ~= 9 "tab"])
ifTrue:
[buffer at: n put: $<. n := n + 1.
(byte = 10 or: [byte = 13])
ifTrue:
[byte = 10
ifTrue: [buffer at: n put: $L; at: n + 1 put: $F]
ifFalse: [buffer at: n put: $C; at: n + 1 put: $R].
n := n + 2]
ifFalse:
[byte >= 10 ifTrue:
[buffer at: n put: byte // 10 + $0 asInteger. n := n + 1].
buffer at: n put: byte \\ 10 + $0 asInteger. n := n + 1].
buffer at: n put: $>. n := n + 1]
ifFalse: [buffer at: n put: byte. n := n + 1]].
'%.*s%s\n' f: aStream printf: { n. buffer. (self numBytesOfBytes: oop) > limit ifTrue: ['...'] ifFalse: [''] }]
ifFalse:
[| wideBuffer word |
self assert: (self isWordsNonImm: oop).
wideBuffer := self cCoerce: (self alloca: 1024 * 4) to: 'int *'.
n := i := 0.
limit := (self lengthOf: oop) min: 256.
[i < limit] whileTrue:
[word := self fetchLong32: i ofObject: oop.
i := i + 1.
(word < 32 "space" and: [word ~= 9 "tab"])
ifTrue:
[wideBuffer at: n put: $<. n := n + 1.
(word = 10 or: [word = 13])
ifTrue:
[word = 10
ifTrue: [wideBuffer at: n put: $L; at: n + 1 put: $F]
ifFalse: [wideBuffer at: n put: $C; at: n + 1 put: $R].
n := n + 2]
ifFalse:
[word >= 10 ifTrue:
[wideBuffer at: n put: word // 10 + $0 asInteger. n := n + 1].
wideBuffer at: n put: word \\ 10 + $0 asInteger. n := n + 1].
wideBuffer at: n put: $>. n := n + 1]
ifFalse: [wideBuffer at: n put: word. n := n + 1]].
+ '%.*ls%s\n' asWideString f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!
- '%.*ls%s\n' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!
Item was changed:
----- Method: StackInterpreter>>externalDivorceFrame:andContext: (in category 'frame access') -----
externalDivorceFrame: theFP andContext: ctxt
"Divorce a single frame and its context. If it is not the top frame of a stack this means splitting its stack."
+ <var: 'theFP' type: #'char *'>
- | thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP |
<inline: false>
+ | thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP |
"stackPage needs to have current head pointers to avoid confusion."
self assert: (stackPage isNil or: [stackPage = stackPages mostRecentlyUsedPage]).
thePage := stackPages stackPageFor: theFP.
(onCurrent := thePage = stackPage) ifFalse:
[stackPages markStackPageNextMostRecentlyUsed: thePage].
theSP := self findSPOf: theFP on: thePage.
self updateStateOfSpouseContextForFrame: theFP WithSP: theSP.
callerCtx := self ensureCallerContext: theFP.
(frameAbove := self findFrameAbove: theFP inPage: thePage) = 0
ifTrue: "If we're divorcing the top frame we can simply peel it off."
[theIP := stackPages longAt: thePage headSP]
ifFalse: "othewise move all frames above to a new stack and then peel the frame off."
[newPage := stackPages newStackPage.
theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove).
frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage.
onCurrent
ifTrue:
[self setStackPageAndLimit: newPage.
self setStackPointersFromPage: newPage]
ifFalse:
[stackPages markStackPageMostRecentlyUsed: newPage].
self assert: (self frameCallerContext: frameAbove) = ctxt].
objectMemory storePointerUnchecked: InstructionPointerIndex
ofObject: ctxt
withValue: (self contextInstructionPointer: theIP frame: theFP).
objectMemory storePointer: SenderIndex
ofObject: ctxt
withValue: callerCtx.
callerFP := self frameCallerFP: theFP.
callerFP = 0 "theFP is a base frame; it is now alone; free the entire page"
ifTrue: [stackPages freeStackPage: thePage]
ifFalse:
[callerIP := self oopForPointer: (self frameCallerSavedIP: theFP).
callerSP := (self frameCallerSP: theFP) - objectMemory wordSize.
stackPages longAt: callerSP put: callerIP.
self setHeadFP: callerFP andSP: callerSP inPage: thePage]
!
Item was changed:
----- Method: StackInterpreter>>printContext: (in category 'debug printing') -----
printContext: aContext
<export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h"
| sender ip sp |
<inline: false>
self shortPrintContext: aContext.
sender := objectMemory fetchPointer: SenderIndex ofObject: aContext.
ip := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
(objectMemory isIntegerObject: sender)
ifTrue:
[(self checkIsStillMarriedContext: aContext currentFP: framePointer)
ifTrue: [self print: 'married (assuming framePointer valid)'; cr]
ifFalse: [self print: 'widowed (assuming framePointer valid)'; cr].
self print: 'sender '; printNum: sender; print: ' (';
+ printHexPtrnp: (self withoutSmallIntegerTags: sender); printChar: $); cr.
- printHex: (self withoutSmallIntegerTags: sender); printChar: $); cr.
self print: 'ip '; printNum: ip; print: ' (';
+ printHexPtrnp: (self withoutSmallIntegerTags: ip); printChar: $); cr]
- printHex: (self withoutSmallIntegerTags: ip); printChar: $); cr]
ifFalse:
[self print: 'sender '; shortPrintOop: sender.
self print: 'ip '.
ip = objectMemory nilObject
ifTrue: [self shortPrintOop: ip]
ifFalse: [self printNum: ip; print: ' ('; printNum: (objectMemory integerValueOf: ip); space; printHex: (objectMemory integerValueOf: ip); printChar: $); cr]].
sp := objectMemory fetchPointer: StackPointerIndex ofObject: aContext.
self print: 'sp '; printNum: (objectMemory integerValueOf: sp); print: ' ('; printHex: sp; printChar: $); cr.
self print: 'method '; printMethodFieldForPrintContext: aContext.
self print: 'closure '; shortPrintOop: (objectMemory fetchPointer: ClosureIndex ofObject: aContext).
self print: 'receiver '; shortPrintOop: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext).
sp := objectMemory integerValueOf: sp.
sp := sp min: (objectMemory lengthOf: aContext) - ReceiverIndex.
1 to: sp do:
[:i|
self print: ' '; printNum: i; space; shortPrintOop: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)]!
Item was changed:
----- Method: StackInterpreter>>printFrameThing:at: (in category 'debug printing') -----
printFrameThing: name at: address
<inline: #always>
+ self printFrameThing: name at: address extraString: (self cCoerceSimple: nil to: #'char *')!
- self printFrameThing: name at: address extraString: nil!
Item was changed:
----- Method: StackInterpreter>>printStackPage:useCount: (in category 'debug printing') -----
printStackPage: page useCount: n
<inline: false>
<var: #page type: #'StackPage *'>
+ self print: 'page '; printHexPtrnp: (self cCode: [page] inSmalltalk: [page baseAddress]);
- self print: 'page '; printHex: (self cCode: [page] inSmalltalk: [page baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page realStackLimit).
n >= 0 ifTrue:
[self print: ','; printNum: n].
self print: ') (trace: '; printNum: page trace; printChar: $).
(stackPages isFree: page) ifTrue:
[self print: ' (free)'].
page = stackPages mostRecentlyUsedPage ifTrue:
[self print: ' (MRU)'].
page prevPage = stackPages mostRecentlyUsedPage ifTrue:
[self print: ' (LRU)'].
self cr; tab; print: 'ba: ';
printHex: page baseAddress; print: ' - sl: ';
printHex: page realStackLimit; print: ' - sl-so: ';
printHex: page realStackLimit - self stackLimitOffset; print: ' - la:';
printHex: page lastAddress.
(stackPages isFree: page) ifFalse:
+ [self cr; tab; print: 'baseFP '; printHexPtrnp: page baseFP.
+ self "cr;" tab; print: 'headFP '; printHexPtrnp: page headFP.
+ self "cr;" tab; print: 'headSP '; printHexPtrnp: page headSP].
+ self cr; tab; print: 'prev '; printHexPtrnp: (self cCode: 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
- [self cr; tab; print: 'baseFP '; printHex: page baseFP.
- self "cr;" tab; print: 'headFP '; printHex: page headFP.
- self "cr;" tab; print: 'headSP '; printHex: page headSP].
- self cr; tab; print: 'prev '; printHex: (self cCode: 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page prevPage realStackLimit); printChar: $).
+ self tab; print: 'next '; printHexPtrnp: (self cCode: 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
- self tab; print: 'next '; printHex: (self cCode: 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page nextPage realStackLimit); printChar: $).
self cr!
Item was changed:
----- Method: StackInterpreter>>withoutSmallIntegerTags: (in category 'frame access') -----
withoutSmallIntegerTags: anInteger
<inline: true>
<returnTypeC: #'char *'>
self assert: (objectMemory isIntegerObject: anInteger).
+ ^self pointerForOop: anInteger - objectMemory smallIntegerTag!
- ^self pointerForOop: (anInteger - 1)!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveAllVMParameters: (in category 'system control primitives') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveGetVMParameter: (in category 'system control primitives') -----
primitiveGetVMParameter: arg
"See primitiveVMParameter method comment.
N.B. written as a returning case to avoid branch limits in the V3 bytecode set."
arg caseOf: {
[1] -> [^self positiveMachineIntegerFor: objectMemory oldSpaceSize].
[2] -> [^objectMemory integerObjectOf: objectMemory newSpaceSize].
[3] -> [^self positiveMachineIntegerFor: objectMemory totalMemorySize].
[6] -> [^objectMemory integerObjectOf: objectMemory tenuringThreshold].
[7] -> [^objectMemory integerObjectOf: objectMemory statFullGCs].
[8] -> [^objectMemory integerObjectOf: objectMemory statFullGCUsecs + 500 // 1000].
[9] -> [^objectMemory integerObjectOf: (objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory statScavenges]
ifFalse: [objectMemory statIncrGCs])].
[10] -> [^objectMemory integerObjectOf: (objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory statScavengeGCUsecs]
ifFalse: [objectMemory statIncrGCUsecs]) + 500 // 1000].
[11] -> [^objectMemory integerObjectOf: objectMemory statTenures].
[12] -> [^objectMemory integerObjectOf: eventTraceMask].
[13] -> [^self getVMTickerStartUSecs].
[14] -> [^self getVMTickerCount].
[15] -> [^self getVMTickeeCallCount].
[16] -> [^self positive64BitIntegerFor: statIdleUsecs].
[17] -> [^(SistaVM and: [self isCog])
ifTrue: [objectMemory floatObjectOf: self getCogCodeZoneThreshold]
ifFalse: [ConstZero]].
[18] -> [^objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory integerObjectOf: objectMemory statCompactionUsecs + 500 // 1000]
ifFalse: [ConstZero]].
[19] -> [^objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory integerObjectOf: objectMemory scavengeThresholdAsExtent]
ifFalse: [ConstZero]].
[20] -> [^objectMemory positive64BitIntegerFor: self ioUTCStartMicroseconds].
[21] -> [^objectMemory integerObjectOf: objectMemory rootTableCount].
[22] -> [^objectMemory integerObjectOf: objectMemory statRootTableOverflows].
[23] -> [^objectMemory integerObjectOf: extraVMMemory].
[24] -> [^objectMemory integerObjectOf: objectMemory shrinkThreshold].
[25] -> [^objectMemory integerObjectOf: objectMemory growHeadroom].
[26] -> [^objectMemory integerObjectOf: self ioHeartbeatMilliseconds].
[27] -> [^objectMemory integerObjectOf: objectMemory statMarkCount].
[28] -> [^objectMemory integerObjectOf: objectMemory statSweepCount].
[29] -> [^objectMemory integerObjectOf: objectMemory statMkFwdCount].
[30] -> [^objectMemory integerObjectOf: objectMemory statCompMoveCount].
[31] -> [^objectMemory integerObjectOf: objectMemory statGrowMemory].
[32] -> [^objectMemory integerObjectOf: objectMemory statShrinkMemory].
[33] -> [^objectMemory integerObjectOf: objectMemory statRootTableCount].
[34] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:"was statAllocationCount"
[objectMemory positive64BitIntegerFor: objectMemory currentAllocatedBytes]].
[35] -> [^objectMemory integerObjectOf: objectMemory statSurvivorCount].
[36] -> [^objectMemory integerObjectOf: (self microsecondsToMilliseconds: objectMemory statGCEndUsecs)].
[37] -> [^objectMemory integerObjectOf: objectMemory statSpecialMarkCount].
[38] -> [^objectMemory integerObjectOf: objectMemory statIGCDeltaUsecs + 500 // 1000].
[39] -> [^objectMemory integerObjectOf: statPendingFinalizationSignals].
[40] -> [^objectMemory integerObjectOf: objectMemory wordSize].
[41] -> [^objectMemory integerObjectOf: self imageFormatVersion].
[42] -> [^objectMemory integerObjectOf: numStackPages].
[43] -> [^objectMemory integerObjectOf: desiredNumStackPages].
[44] -> [^objectMemory integerObjectOf: objectMemory edenBytes].
[45] -> [^objectMemory integerObjectOf: desiredEdenBytes].
[46] -> [^self getCogCodeSize].
[47] -> [^self getDesiredCogCodeSize].
[48] -> [^self getImageHeaderFlagsParameter].
[49] -> [^objectMemory integerObjectOf: self ioGetMaxExtSemTableSize].
[52] -> [^objectMemory integerObjectOf: objectMemory rootTableCapacity].
[53] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[objectMemory integerObjectOf: objectMemory numSegments]].
[54] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[objectMemory integerObjectOf: objectMemory freeSize]].
[55] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[objectMemory floatObjectOf: objectMemory getHeapGrowthToSizeGCRatio]].
[56] -> [^self positive64BitIntegerFor: statProcessSwitch].
[57] -> [^self positive64BitIntegerFor: statIOProcessEvents].
[58] -> [^self positive64BitIntegerFor: statForceInterruptCheck].
[59] -> [^self positive64BitIntegerFor: statCheckForEvents].
[60] -> [^self positive64BitIntegerFor: statStackOverflow].
[61] -> [^self positive64BitIntegerFor: statStackPageDivorce].
[62] -> [^self getCodeCompactionCount].
[63] -> [^self getCodeCompactionMSecs].
[64] -> [^self getCogMethodCount].
[65] -> [^self getCogVMFeatureFlags].
+ [66] -> [^objectMemory integerObjectOf: stackPages bytesPerPage].
- [66] -> [^objectMemory integerObjectOf: self stackPageByteSize].
[67] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[self positiveMachineIntegerFor: objectMemory maxOldSpaceSize]].
[68] -> [^objectMemory floatObjectOf: stackPages statAverageLivePagesWhenMapping].
[69] -> [^objectMemory integerObjectOf: stackPages statMaxPageCountWhenMapping].
[70] -> [^objectMemory integerObjectOf: self vmProxyMajorVersion].
[71] -> [^objectMemory integerObjectOf: self vmProxyMinorVersion].
[72] -> [^objectMemory integerObjectOf: objectMemory statMarkUsecs + 500 // 1000].
[73] -> [^objectMemory integerObjectOf: objectMemory statSweepUsecs + 500 // 1000].
[74] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[objectMemory integerObjectOf: objectMemory statMaxAllocSegmentTime + 500 // 1000]].
[75] -> [^objectMemory booleanObjectOf: self primitiveDoMixedArithmetic].
[76] -> [^objectMemory integerObjectOf: self minimumUnusedHeadroom] }
otherwise: [^nil]!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiLoadCalloutAddressFrom: (in category 'symbol loading') -----
ffiLoadCalloutAddressFrom: oop
"Load the function address for a call out to an external function"
| module moduleHandle functionName address |
<inline: false>
"First find and load the module"
module := interpreterProxy fetchPointer: externalFunctionInstSize + 1 ofObject: oop.
moduleHandle := self ffiLoadCalloutModule: module.
interpreterProxy failed ifTrue:
[^0]. "failed"
"fetch the function name"
functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: oop.
(interpreterProxy isBytes: functionName) ifFalse:
[^self ffiFail: FFIErrorBadExternalFunction].
address := (interpreterProxy
ioLoadSymbol: (interpreterProxy firstIndexableField: functionName) asInteger
OfLength: (interpreterProxy byteSizeOf: functionName)
+ FromModule: moduleHandle asVoidPointer) asInteger.
- FromModule: moduleHandle) asInteger.
(interpreterProxy failed or: [address = 0]) ifTrue:
[^self ffiFail: FFIErrorAddressNotFound].
^address!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveLoadSymbolFromModule (in category 'primitives') -----
primitiveLoadSymbolFromModule
"Attempt to find the address of a symbol in a loaded library.
loadSymbol: aSymbol fromModule: moduleName
<primitive: 'primitiveLoadSymbolFromModule' error: errorCode module: 'SqueakFFIPrims'>
"
<export: true>
| symbol module moduleHandle address oop ptr |
<var: #address type: #'void *'>
<var: #ptr type: #'void **'>
interpreterProxy methodArgumentCount = 2 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
module := interpreterProxy stackValue: 0.
symbol := interpreterProxy stackValue: 1.
moduleHandle := module ~= interpreterProxy nilObject ifTrue:
[self ffiLoadCalloutModule: module].
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNotFound].
address := interpreterProxy
ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: symbol) to: #sqInt)
OfLength: (interpreterProxy byteSizeOf: symbol)
+ FromModule: moduleHandle asVoidPointer.
- FromModule: moduleHandle.
(interpreterProxy failed
or: [address = 0]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNotFound].
oop := interpreterProxy
instantiateClass: interpreterProxy classExternalAddress
indexableSize: (self sizeof: #'void *').
ptr := interpreterProxy firstIndexableField: oop.
ptr at: 0 put: address.
^interpreterProxy methodReturnValue: oop!
More information about the Vm-dev
mailing list