[Vm-dev] VM Maker: VMMaker.oscog-eem.3268.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Nov 8 19:46:09 UTC 2022
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3268.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3268
Author: eem
Time: 8 November 2022, 11:45:51.001808 am
UUID: b157851d-3135-4853-9b4a-b72296787205
Ancestors: VMMaker.oscog-eem.3267
Fix several sends of [positive|signed]MachineIntegerFor: which is implemented in InterpreterPlugin, not InterpreterProxy.
Refactor call logging in the ThreadedFFIPlugin to get as much of the logging code out of the critical path as possible.
=============== Diff against VMMaker.oscog-eem.3267 ===============
Item was changed:
----- Method: ClipboardExtendedPlugin>>ioCreateClipboard (in category 'io') -----
ioCreateClipboard
self primitive: 'ioCreateClipboard' parameters: #().
+ ^self positiveMachineIntegerFor: self sqCreateClipboard asUnsignedInteger!
- ^interpreterProxy positiveMachineIntegerFor: self sqCreateClipboard asUnsignedInteger!
Item was changed:
----- Method: HostWindowPlugin>>primitiveSqueakWindowHandle (in category 'system primitives') -----
primitiveSqueakWindowHandle
<option: #TerfVM>
"Answer the native Squeak window handle, presumably a pointer, as an unsigned integer.
This value should be usable in native calls to the window manager as well as
the argument to primitiveNativeWindowPosition:"
| handle |
<var: #handle type: 'void *'>
self primitive: 'primitiveSqueakWindowHandle'.
handle := self ioGetWindowHandle.
handle = 0 ifTrue:
[^interpreterProxy primitiveFail].
+ ^self positiveMachineIntegerFor: (self cCoerceSimple: handle to: #usqInt)!
- ^interpreterProxy positiveMachineIntegerFor: (self cCoerceSimple: handle to: #sqInt)!
Item was changed:
----- Method: IA32ABIPlugin>>primUnsignedWordAt (in category 'primitives-accessing') -----
primUnsignedWordAt
"Answer the unsigned word starting at the given byte offset (little endian)."
"<Alien> unsignedWordAt: index <Integer> ^<Integer>
<primitive: 'primUnsignedWordAt' error: errorCode module: 'IA32ABI'>"
| byteOffset rcvr startAddr value |
<export: true>
byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self index: byteOffset length: interpreterProxy bytesPerOop inRange: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
(startAddr := self startOfData: rcvr) = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
value := self cCode: [self longAt: startAddr + byteOffset]
inSmalltalk: [(self alienFor: rcvr at: startAddr) unsignedWordAt: byteOffset + 1].
+ ^interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: value)!
- ^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: value)!
Item was changed:
----- Method: MacMenubarPlugin>>primitiveCreateStandardWindowMenu: (in category 'system primitives') -----
primitiveCreateStandardWindowMenu: inOptions
<var: #menuHandle type: #MenuHandle>
| menuHandle result |
self primitive: 'primitiveCreateStandardWindowMenu'
parameters: #(SmallInteger).
self cppIf: #'TARGET_API_MAC_CARBON'
ifTrue: [result := self cCode: 'CreateStandardWindowMenu(inOptions,&menuHandle);' inSmalltalk:[0]].
+ ^self positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
- ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
Item was changed:
----- Method: MacMenubarPlugin>>primitiveGetIndMenuWithCommandID:commandID: (in category 'system primitives') -----
primitiveGetIndMenuWithCommandID: menuHandleOop commandID: aCommandID
<var: #menuHandle type: #MenuHandle>
<var: #commandID type: #MenuCommand>
<var: #applicationMenu type: #MenuHandle>
<var: #outIndex type: #MenuItemIndex>
| menuHandle commandID applicationMenu outIndex |
self primitive: 'primitiveGetIndMenuWithCommandID'
parameters: #(Oop Oop).
menuHandle := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: menuHandleOop) to: 'MenuHandle'.
commandID := self cCoerce: (interpreterProxy positive32BitValueOf: aCommandID) to: 'MenuCommand'.
(self ioCheckMenuHandle: menuHandle) ifFalse: [^interpreterProxy success: false].
self cppIf: #'TARGET_API_MAC_CARBON'
ifTrue: [self cCode: 'GetIndMenuItemWithCommandID(menuHandle, kHICommandHide, 1,
&applicationMenu, &outIndex);' inSmalltalk: [menuHandle]].
outIndex asSmallIntegerObj. "to avoid elimination of the variable..."
+ ^self positiveMachineIntegerFor: (self cCoerce: applicationMenu to: #'usqIntptr_t')
- ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: applicationMenu to: #'usqIntptr_t')
!
Item was changed:
----- Method: MacMenubarPlugin>>primitiveGetMenuBar (in category 'system primitives') -----
+ primitiveGetMenuBar
+ self primitive: 'primitiveGetMenuBar' parameters: #().
+ ^self positiveMachineIntegerFor: (self cCoerce: self GetMenuBar to: #'usqIntptr_t')!
- primitiveGetMenuBar
- <var: #menuHandle type: #Handle>
- | menuHandle |
- self primitive: 'primitiveGetMenuBar'
- parameters: #().
- menuHandle := self cCode: 'GetMenuBar()' inSmalltalk:[0].
- ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
Item was changed:
----- Method: MacMenubarPlugin>>primitiveGetMenuHandle: (in category 'system primitives') -----
+ primitiveGetMenuHandle: menuID
- primitiveGetMenuHandle: menuID
- <var: #menuHandle type: #MenuHandle>
<var: #menuID type: #MenuID>
+ self primitive: 'primitiveGetMenuHandle' parameters: #(SmallInteger).
+ ^self positiveMachineIntegerFor: (self cCoerce: (self GetMenuHandle: menuID) to: #'usqIntptr_t')!
- | menuHandle |
- self primitive: 'primitiveGetMenuHandle'
- parameters: #(SmallInteger).
- menuHandle := self cCode: 'GetMenuHandle(menuID)' inSmalltalk:[0].
- ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
Item was changed:
----- Method: MacMenubarPlugin>>primitiveNewMenu:menuTitle: (in category 'system primitives') -----
primitiveNewMenu: menuID menuTitle: menuTitle
- <var: #menuHandle type: #MenuHandle>
- <var: #constStr255 type: #ConstStr255Param>
<var: #menuID type: #MenuID>
+ self primitive: 'primitiveNewMenu' parameters: #(SmallInteger ByteArray).
+ ^self positiveMachineIntegerFor: (self cCoerce: (self NewMenu: menuID _: (self cCoerce: menuTitle to: #ConstStr255Param)) to: #'usqIntptr_t')!
- | menuHandle constStr255 |
- self primitive: 'primitiveNewMenu'
- parameters: #(SmallInteger ByteArray).
- constStr255 := self cCoerce: menuTitle to: #ConstStr255Param.
- menuHandle := self cCode: 'NewMenu(menuID,constStr255)' inSmalltalk:[0].
- ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
Item was added:
+ ----- Method: ThreadedFFIPlugin>>doFFILogCallout: (in category 'symbol loading') -----
+ doFFILogCallout: lit
+ "The non-simulation version of this lives in platforms/Cross/plugins/SqueakFFIPrims/sqFFIPlugin.c"
+ <doNotGenerate>
+ | functionName |
+ functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: lit.
+ (interpreterProxy isBytes: functionName) ifTrue:
+ ['FFI call of %.*s\n'
+ f: interpreterProxy transcript
+ printf: {interpreterProxy firstIndexableField: functionName. interpreterProxy byteSizeOf: functionName}]!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiCreateIntegralResultOop:ofAtomicType:in: (in category 'callout support') -----
ffiCreateIntegralResultOop: retVal ofAtomicType: atomicType in: calloutState
<inline: #always>
<var: 'calloutState' type: #'CalloutState *'>
<var: 'retVal' type: #usqLong> "Support up to int64_t or uint64_t"
"Callout support. Return the appropriate oop for the given atomic type"
| shift value mask byteSize |
<var: 'value' type: #usqLong>
<var: 'mask' type: #usqLong>
self deny: (self isFloatAtomicType: atomicType).
atomicType = FFITypeBool ifTrue:
["Make sure bool honors the byte size requested"
byteSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask.
value := byteSize = (self sizeof: retVal)
ifTrue: [retVal]
ifFalse: [retVal bitAnd: 1 asUnsignedLongLong << (byteSize * 8) - 1].
^value = 0
ifTrue: [interpreterProxy falseObject]
ifFalse: [interpreterProxy trueObject]].
atomicType <= FFITypeSignedInt32 ifTrue:
["these are all generall integer returns"
atomicType <= (BytesPerWord = 8 ifTrue: [FFITypeSignedInt32] ifFalse: [FFITypeSignedInt16]) ifTrue:
["byte/short(/int). first extract partial word, then sign extend"
shift := (BytesPerWord = 8 and: [atomicType >= FFITypeUnsignedInt32])
ifTrue: [32]
ifFalse: [(atomicType >> 1) * 8]. "# of significant bits"
value := retVal bitAnd: (1 asUnsignedLongLong << shift - 1).
(atomicType anyMask: 1) ifTrue:
["make the guy signed"
mask := 1 asUnsignedLongLong << (shift-1).
value := (value bitAnd: mask-1) - (value bitAnd: mask)].
^interpreterProxy integerObjectOf: value].
"Word sized integer return"
^(atomicType anyMask: 1)
+ ifTrue: [self signedMachineIntegerFor: retVal] "signed return"
+ ifFalse: [self positiveMachineIntegerFor: retVal]]. "unsigned return"
- ifTrue: [interpreterProxy signedMachineIntegerFor: retVal] "signed return"
- ifFalse: [interpreterProxy positiveMachineIntegerFor: retVal]]. "unsigned return"
"int64_6, uint64_t"
(atomicType >> 1) = (FFITypeSignedInt64 >> 1) ifTrue:
[^(atomicType anyMask: 1)
ifTrue: [interpreterProxy signed64BitIntegerFor: retVal] "signed return"
ifFalse: [interpreterProxy positive64BitIntegerFor: retVal]]. "unsigned return"
"char"
self assert: (self isCharacterAtomicType: atomicType).
^atomicType caseOf: {
[FFITypeUnsignedChar8] -> [interpreterProxy characterObjectOf: (retVal bitAnd: 16rFF)].
[FFITypeSignedChar8] -> [interpreterProxy characterObjectOf: (retVal bitAnd: 16rFF)].
[FFITypeUnsignedChar16] -> [interpreterProxy characterObjectOf: (retVal bitAnd: 16rFFFF)].
[FFITypeUnsignedChar32] -> [interpreterProxy characterObjectOf: (self cCoerce: retVal to: #'unsigned int')] }!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiLogCallout: (in category 'symbol loading') -----
ffiLogCallout: lit
<returnTypeC: #void>
+ <inline: #always>
+ ffiLogEnabled ifTrue: [self doFFILogCallout: lit]!
- "fetch the function name"
- | functionName |
- ffiLogEnabled ifTrue:[
- functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: lit.
- (interpreterProxy isBytes: functionName) ifFalse:[^nil].
- self ffiLogCall: (interpreterProxy firstIndexableField: functionName)
- OfLength: (interpreterProxy byteSizeOf: functionName).
- ].!
Item was changed:
----- Method: VMProfileMacSupportPlugin>>primitiveDLSym (in category 'primitives') -----
primitiveDLSym
"Answer the address of the argument in the current process or nil if none."
- | nameObj name namePtr sz addr |
<export: true>
- <var: #name type: #'char *'>
- <var: #namePtr type: #'char *'>
<var: #addr type: #'void *'>
+ (interpreterProxy stackEphemeralStringValue: 0) ifNotNil:
+ [:symbolName| | addr |
+ addr := self dlsym: #RTLD_SELF _: symbolName.
+ interpreterProxy methodReturnValue: (addr = 0
+ ifTrue: [interpreterProxy nilObject]
+ ifFalse: [self positiveMachineIntegerFor: addr asUnsignedIntegerPtr])]!
- nameObj := interpreterProxy stackValue: 0.
- (interpreterProxy isBytes: nameObj) ifFalse:
- [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- sz := interpreterProxy byteSizeOf: nameObj.
- name := self malloc: sz+1.
- namePtr := interpreterProxy firstIndexableField: nameObj.
- 0 to: sz-1 do:[:i| name at: i put: (namePtr at: i)].
- name at: sz put: 0.
- addr := self cCode: 'dlsym(RTLD_SELF,name)' inSmalltalk: [0].
- self free: name.
- ^interpreterProxy methodReturnValue: (addr = 0
- ifTrue: [interpreterProxy nilObject]
- ifFalse: [interpreterProxy positiveMachineIntegerFor: addr asUnsignedIntegerPtr])!
Item was changed:
----- Method: VMProfileMacSupportPlugin>>primitiveExecutableModulesAndOffsets (in category 'primitives') -----
primitiveExecutableModulesAndOffsets
"Answer an Array of quads for executable modules (the VM executable
and loaded libraries). Each quad is the module's name, its vm address
relocation in memory, the (unrelocated) start address, and the size."
| nimages resultObj name valueObj nameObjData slide start size |
<export: true>
<var: #name type: 'const char *'>
<var: #nameObjData type: #'char *'>
<var: #h type: 'const struct mach_header *'>
<var: #h64 type: 'const struct mach_header_64 *'>
<var: #s64 type: 'const struct section_64 *'>
<var: #s type: 'const struct section *'>
<var: #start type: 'usqIntptr_t'>
<var: #slide type: 'usqIntptr_t'>
<var: #size type: 'usqIntptr_t'>
nimages := self _dyld_image_count.
resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: nimages * 4.
resultObj = 0 ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- [^interpreterProxy primitiveFail].
interpreterProxy pushRemappableOop: resultObj.
0 to: nimages - 1 do:
[:i|
start := size := -1. "impossible start & size"
name := self _dyld_get_image_name: i.
slide := self _dyld_get_image_vmaddr_slide: i.
self cppIf: #'__x86_64__' | #'__arm64__'
ifTrue:
[(self cCoerceSimple: (self _dyld_get_image_header: i)
to: #'const struct mach_header_64 *') ifNotNil:
[:h64|
(self getsectbynamefromheader_64: h64 _: #SEG_TEXT _: #SECT_TEXT) ifNotNil:
[:s64|
start := s64 addr.
size := s64 size]]]
ifFalse:
[(self _dyld_get_image_header: i) ifNotNil:
[:h|
(self getsectbynamefromheader: h _: #SEG_TEXT _: #SECT_TEXT) ifNotNil:
[:s|
start := s addr.
size := s size]]].
valueObj := interpreterProxy
instantiateClass: interpreterProxy classString
indexableSize: (self strlen: name).
interpreterProxy failed ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy storePointer: i * 4 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
nameObjData := interpreterProxy arrayValueOf: valueObj.
self memcpy: nameObjData _: name _: (self strlen: name).
+ valueObj := self signedMachineIntegerFor: slide.
- valueObj := interpreterProxy signedMachineIntegerFor: slide.
interpreterProxy failed ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy storePointer: i * 4 + 1 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
+ valueObj := self positiveMachineIntegerFor: start.
- valueObj := interpreterProxy positiveMachineIntegerFor: start.
interpreterProxy failed ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy storePointer: i * 4 + 2 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
+ valueObj := self positiveMachineIntegerFor: size.
- valueObj := interpreterProxy positiveMachineIntegerFor: size.
interpreterProxy failed ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy storePointer: i * 4 + 3 ofObject: interpreterProxy topRemappableOop withValue: valueObj].
^interpreterProxy methodReturnValue: interpreterProxy popRemappableOop!
Item was changed:
----- Method: VMProfileMacSupportPlugin>>primitiveTextSymbols (in category 'primitives') -----
primitiveTextSymbols
"Answer an Array of pairs of address, name, for text symbols in the n'th loaded module,
as defined by the _dyld_image_count enumeration."
| moduleIndex resultObj slide start end dlInfos dlInfo ndlInfos index last_saddr increment |
<export: true>
<var: 'nameObjData' type: #'char *'>
<var: 'h' type: 'const struct mach_header *'>
<var: 'h64' type: 'const struct mach_header_64 *'>
<var: 's64' type: 'const struct section_64 *'>
<var: 's' type: 'const struct section *'>
<var: 'start' type: #'usqIntptr_t'>
<var: 'slide' type: #'usqIntptr_t'>
<var: 'end' type: #'usqIntptr_t'>
<var: 'dlInfos' type: 'Dl_info *'>
<var: 'dlInfo' type: 'Dl_info'>
<var: 'last_saddr' type: #'void *'>
moduleIndex := interpreterProxy stackValue: 0.
((interpreterProxy isIntegerObject: moduleIndex)
and: [(moduleIndex := interpreterProxy integerValueOf: moduleIndex) >= 0
and: [(self _dyld_get_image_name: moduleIndex) notNil]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start := 0.
slide := self _dyld_get_image_vmaddr_slide: moduleIndex.
self cppIf: #'__x86_64__' | #'__arm64__'
ifTrue:
[(self cCoerceSimple: (self _dyld_get_image_header: moduleIndex)
to: #'const struct mach_header_64 *') ifNotNil:
[:h64|
(self getsectbynamefromheader_64: h64 _: #SEG_TEXT _: #SECT_TEXT) ifNotNil:
[:s64|
start := s64 addr + slide.
end := start + s64 size]]]
ifFalse:
[(self _dyld_get_image_header: moduleIndex) ifNotNil:
[:h|
(self getsectbynamefromheader: h _: #SEG_TEXT _: #SECT_TEXT) ifNotNil:
[:s|
start := s addr.
end := start + s size]]].
start = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrOperationFailed].
(dlInfos := self malloc: (self sizeof: #'Dl_info') * (ndlInfos := increment := 1024)) ifNil:
[^interpreterProxy primitiveFailFor: PrimErrNoCMemory].
index := 0.
last_saddr := nil.
"Yes, dear reader, one could use binary search to reduce the amount of effort. But when this author
attempted to do so, he achieved only a marginal improvement for a substantial increase in complexity.
So KISS and do a linear scan, looking ahead 64 bytes to reduce overhead as simply as possible. 64 gave
best results when tried on the VM module of an ARMv8/aarch64 VM; about 2.5x a naive step by sizeof(void *)."
[start < end and: [(self dladdr: start asVoidPointer _: dlInfos + index) ~= 0]] whileTrue:
[(start + 64 < end
and: [(self dladdr: (start + 64) asVoidPointer _: (self addressOf: dlInfo)) ~= 0
and: [dlInfo dli_saddr = (dlInfos at: index) dli_saddr]])
ifTrue: [start := start + 64 + (self sizeof: #'void *')]
ifFalse: [start := start + (self sizeof: #'void *')].
last_saddr ~= (dlInfos at: index) dli_saddr ifTrue:
[last_saddr := (dlInfos at: index) dli_saddr.
(index := index + 1) = ndlInfos ifTrue:
[dlInfos := self reallocf: dlInfos _: (self sizeof: #'Dl_info') * (ndlInfos + increment).
dlInfos ifNil:
[^interpreterProxy primitiveFailFor: PrimErrNoCMemory].
ndlInfos := ndlInfos + increment.
increment := increment * 2]]].
resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: index * 2.
resultObj = 0 ifTrue:
[self free: dlInfos.
^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy pushRemappableOop: resultObj.
ndlInfos := index.
index := 0.
[index < ndlInfos] whileTrue:
[| valueObj nameObjData |
+ valueObj := self positiveMachineIntegerFor: (dlInfos at: index) dli_saddr.
- valueObj := interpreterProxy positiveMachineIntegerFor: (dlInfos at: index) dli_saddr.
interpreterProxy failed ifTrue:
[self free: dlInfos.
interpreterProxy popRemappableOop.
^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy storePointer: index * 2 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
valueObj := interpreterProxy
instantiateClass: interpreterProxy classString
indexableSize: (self strlen: (dlInfos at: index) dli_sname).
interpreterProxy failed ifTrue:
[self free: dlInfos.
interpreterProxy popRemappableOop.
^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy storePointer: index * 2 + 1 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
nameObjData := interpreterProxy arrayValueOf: valueObj.
self memcpy: nameObjData _: (dlInfos at: index) dli_sname _: (self strlen: (dlInfos at: index) dli_sname).
index := index + 1].
self free: dlInfos.
^interpreterProxy methodReturnValue: interpreterProxy popRemappableOop!
More information about the Vm-dev
mailing list