From commits at source.squeak.org Sat Aug 1 02:45:24 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 Aug 2020 02:45:24 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2785.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2785.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2785 Author: eem Time: 31 July 2020, 7:45:15.985473 pm UUID: 9fa77ef1-7255-47f3-9dd1-c500f9529cbb Ancestors: VMMaker.oscog-eem.2784 Plugins: Clean up the SoundPlugin, eloiminating almost all cCode:'s, making it potentially simulateable once the internal API is implemented. Use the methodRetur...: API to simplify a number of primitives. Change primitiveSoundEnableAEC to take either 0, 1 or a boolean. Slang: eliminate the arguments to addressOf:put: blocks via nodeIsDeadCode:withParent: Simulation: implement unsigned coercion in cCoerce:to: to support this form in primitiveSoundEnableAEC (interpreterProxy isIntegerObject: (arg := interpreterProxy stackValue: 0)) ifTrue: [arg := interpreterProxy integerValueOf: arg. (interpreterProxy cCoerce: arg to: #unsigned) > 1 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. trueOrFalse := arg = 1] ifFalse: [(interpreterProxy isBooleanObject: arg) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. trueOrFalse := interpreterProxy booleanValueOf: arg]. =============== Diff against VMMaker.oscog-eem.2784 =============== Item was changed: ----- Method: CCodeGenerator>>nodeIsDeadCode:withParent: (in category 'utilities') ----- nodeIsDeadCode: aNode withParent: parentNode "Answer if aNode would not be generated due to dead code elimination." + (aNode isLiteralBlock and: [parentNode isSend and: [parentNode selector == #addressOf:put:]]) ifTrue: + [^true]. ^(self nilOrBooleanConditionFor: parentNode) ifNil: [false] ifNotNil: [:cond| | filter | filter := parentNode selector caseOf: { "First element is accessor for filtered (eliminated) node if expression is true. Second element is accessor for filtered (eliminated) node if expression is false." [#ifFalse:] -> [#(first nil)]. [#ifFalse:ifTrue:] -> [#(first last)]. [#ifTrue:] -> [#(nil first)]. [#ifTrue:ifFalse:] -> [#(last first)]. [#and:] -> [#(nil first)]. [#or:] -> [#(last nil)]. [#cppIf:ifTrue:] -> [#(nil #second)]. [#cppIf:ifTrue:ifFalse:] -> [#(third #second)] }. (cond ifTrue: [filter first] ifFalse: [filter last]) ifNil: [false] ifNotNil: [:accessor| aNode == (parentNode args perform: accessor)]]! Item was changed: ----- Method: Integer>>coerceTo:sim: (in category '*VMMaker-interpreter simulator') ----- coerceTo: cTypeString sim: interpreter | unitSize | + cTypeString last == $* ifTrue: "C pointer" - cTypeString last = $* ifTrue: "C pointer" [unitSize := cTypeString caseOf: { [#'char *'] -> [1]. [#'short *'] -> [2]. [#'int *'] -> [4]. [#'long long *'] -> [8]. [#'float *'] -> [^CFloatArray basicNew interpreter: interpreter address: self unitSize: 4; yourself]. [#'double *'] -> [^CFloatArray basicNew interpreter: interpreter address: self unitSize: 8; yourself]. [#'unsigned *'] -> [4]. [#'unsigned int *'] -> [4]. [#'unsigned char *'] -> [1]. [#'signed char *'] -> [1]. [#'unsigned short *'] -> [2]. [#'unsigned long long *'] -> [8]. [#'oop *'] -> [interpreter objectMemory bytesPerOop]. } otherwise: [interpreter objectMemory wordSize]. ^CArray basicNew interpreter: interpreter address: self unitSize: unitSize; yourself]. + cTypeString first == $u ifTrue: + [unitSize := cTypeString caseOf: { + [#usqInt] -> [interpreter objectMemory wordSize]. + [#usqLong] -> [8]. + [#unsigned] -> [4]. + [#'unsigned int'] -> [4]. + [#'unsigned char'] -> [1]. + [#'unsigned long'] -> [6]. + [#'unsigned short'] -> [2]. + [#'unsigned long long'] -> [8]. + } + otherwise: [self error: 'unknown unsigned type name']. + ^self bitAnd: 1 << (8 * unitSize) - 1]. + ^self "C number (int, char, etc)"! - ^self "C number (int, char, float, etc)"! Item was added: + ----- Method: InterpreterProxy>>cCoerce:to: (in category 'simulation only') ----- + cCoerce: value to: cTypeString + "Type coercion. For translation a cast will be emitted. When running in Smalltalk + answer a suitable wrapper for correct indexing." + ^value + ifNil: [value] + ifNotNil: [value coerceTo: cTypeString sim: self]! Item was changed: ----- Method: RePlugin>>rcvrMatchSpacePtr (in category 'rcvr linkage') ----- rcvrMatchSpacePtr ^self cCoerce: (interpreterProxy fetchArray: 7 ofObject: rcvr) + to: #'int *'! - to: 'int *'.! Item was changed: ----- Method: RePlugin>>rcvrPatternStrPtr (in category 'rcvr linkage') ----- rcvrPatternStrPtr ^self cCoerce: (interpreterProxy fetchArray: 0 ofObject: rcvr) + to: #'char *'.! - to: 'char *'.! Item was changed: ----- Method: SoundPlugin>>primitiveGetDefaultSoundPlayer (in category 'primitives') ----- primitiveGetDefaultSoundPlayer "Answer a String with the operating system name of the default output device, or nil" "no arguments" - | cDeviceName sz newString newStringPtr | + | cDeviceName | + - - - "Parse arguments" - interpreterProxy methodArgumentCount = 0 - ifFalse:[^interpreterProxy primitiveFail]. - "Get the answer." + cDeviceName := self getDefaultSoundPlayer. + cDeviceName = 0 ifTrue: + [^interpreterProxy methodReturnValue: interpreterProxy nilObject]. - cDeviceName := self cCode: 'getDefaultSoundPlayer()'. - cDeviceName == 0 ifTrue: [ - ^interpreterProxy pop: 1 thenPush: interpreterProxy nilObject - ]. + ^interpreterProxy methodReturnString: cDeviceName! - "Copy the answer to a Squeak String." - sz := self cCode: 'strlen(cDeviceName)'. - newString := interpreterProxy - instantiateClass: interpreterProxy classString - indexableSize: sz. - newStringPtr := interpreterProxy firstIndexableField: newString. - self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'. - - self touch: newStringPtr. - self touch: cDeviceName. - "Pop the receiver, and answer the new string." - ^interpreterProxy pop: 1 thenPush: newString! Item was changed: ----- Method: SoundPlugin>>primitiveGetDefaultSoundRecorder (in category 'primitives') ----- primitiveGetDefaultSoundRecorder "Answer a String with the operating system name of the default input device, or nil" "no arguments" - | cDeviceName sz newString newStringPtr | + | cDeviceName | + - - - "Parse arguments" - interpreterProxy methodArgumentCount = 0 - ifFalse:[^interpreterProxy primitiveFail]. - "Get the answer." + cDeviceName := self getDefaultSoundRecorder. + cDeviceName = 0 ifTrue: + [^interpreterProxy methodReturnValue: interpreterProxy nilObject]. - cDeviceName := self cCode: 'getDefaultSoundRecorder()'. - cDeviceName == 0 ifTrue: [ - ^interpreterProxy pop: 1 thenPush: interpreterProxy nilObject - ]. + ^interpreterProxy methodReturnString: cDeviceName! - "Copy the answer to a Squeak String." - sz := self cCode: 'strlen(cDeviceName)'. - newString := interpreterProxy - instantiateClass: interpreterProxy classString - indexableSize: sz. - newStringPtr := interpreterProxy firstIndexableField: newString. - self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'. - - self touch: newStringPtr. - self touch: cDeviceName. - "Pop the receiver, and answer the new string." - ^interpreterProxy pop: 1 thenPush: newString! Item was changed: ----- Method: SoundPlugin>>primitiveGetNumberOfSoundPlayerDevices (in category 'primitives') ----- primitiveGetNumberOfSoundPlayerDevices - "arguments: name(type, stack offset) - dialString(String, 0)" - "answers an Integer" - | result | + ^interpreterProxy methodReturnInteger: self getNumberOfSoundPlayerDevices! - "Parse arguments" - interpreterProxy methodArgumentCount = 0 - ifFalse:[^interpreterProxy primitiveFail]. - - "get result" - result := self cCode: 'getNumberOfSoundPlayerDevices()'. - - "answer it" - result := interpreterProxy signed32BitIntegerFor: result. - ^interpreterProxy pop: 1 thenPush: result. "pop receiver, return result"! Item was changed: ----- Method: SoundPlugin>>primitiveGetNumberOfSoundRecorderDevices (in category 'primitives') ----- primitiveGetNumberOfSoundRecorderDevices - "arguments: name(type, stack offset) - dialString(String, 0)" - "answers an Integer" - | result | + ^interpreterProxy methodReturnInteger: self getNumberOfSoundRecorderDevices! - "Parse arguments" - interpreterProxy methodArgumentCount = 0 - ifFalse:[^interpreterProxy primitiveFail]. - - "get result" - result := self cCode: 'getNumberOfSoundRecorderDevices()'. - - "answer it" - result := interpreterProxy signed32BitIntegerFor: result. - ^interpreterProxy pop: 1 thenPush: result. "pop receiver, return result"! Item was changed: ----- Method: SoundPlugin>>primitiveGetSoundPlayerDeviceName (in category 'primitives') ----- primitiveGetSoundPlayerDeviceName "arguments: name(type, stack offset) deviceNumber(Integer, 0)" "answers a string or nil" - | deviceNumber sz cDeviceName newString newStringPtr | + | deviceNumber cDeviceName | + - - "Parse arguments" + interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. - interpreterProxy methodArgumentCount = 1 - ifFalse:[^interpreterProxy primitiveFail]. deviceNumber := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). + interpreterProxy failed ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - interpreterProxy failed ifTrue: [^nil]. "Get the answer." + cDeviceName := self getSoundPlayerDeviceName: deviceNumber - 1. + cDeviceName = 0 ifTrue: + [^interpreterProxy methodReturnValue: interpreterProxy nilObject]. - cDeviceName := self cCode: 'getSoundPlayerDeviceName(deviceNumber - 1)'. - cDeviceName == 0 ifTrue: [ - ^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject - ]. + ^interpreterProxy methodReturnString: cDeviceName! - "Copy the answer to a Squeak String." - sz := self cCode: 'strlen(cDeviceName)'. - newString := interpreterProxy - instantiateClass: interpreterProxy classString - indexableSize: sz. - newStringPtr := interpreterProxy firstIndexableField: newString. - self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'. - - self touch: deviceNumber. - self touch: newStringPtr. - self touch: cDeviceName. - "Pop the receiver and arg, and answer the new string." - ^interpreterProxy pop: 2 thenPush: newString! Item was changed: ----- Method: SoundPlugin>>primitiveGetSoundRecorderDeviceName (in category 'primitives') ----- primitiveGetSoundRecorderDeviceName "arguments: name(type, stack offset) deviceNumber(Integer, 0)" "answers a string or nil" - | deviceNumber sz cDeviceName newString newStringPtr | + | deviceNumber cDeviceName | + - - "Parse arguments" + interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. - interpreterProxy methodArgumentCount = 1 - ifFalse:[^interpreterProxy primitiveFail]. - deviceNumber := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). + interpreterProxy failed ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - interpreterProxy failed ifTrue: [^nil]. "Get the answer." + cDeviceName := self getSoundRecorderDeviceName: deviceNumber - 1. + cDeviceName = 0 ifTrue: + [^interpreterProxy methodReturnValue: interpreterProxy nilObject]. - cDeviceName := self cCode: 'getSoundRecorderDeviceName(deviceNumber - 1)'. - cDeviceName == 0 ifTrue: [ - ^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject - ]. + ^interpreterProxy methodReturnString: cDeviceName! - "Copy the answer to a Squeak String." - sz := self cCode: 'strlen(cDeviceName)'. - newString := interpreterProxy - instantiateClass: interpreterProxy classString - indexableSize: sz. - newStringPtr := interpreterProxy firstIndexableField: newString. - self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'. - - self touch: deviceNumber. - self touch: newStringPtr. - self touch: cDeviceName. - "Pop the receiver and arg, and answer the new string." - ^interpreterProxy pop: 2 thenPush: newString! Item was changed: ----- Method: SoundPlugin>>primitiveSetDefaultSoundPlayer (in category 'primitives') ----- primitiveSetDefaultSoundPlayer "Tell the operating system to use the specified device name as the output device for sound." "arg at top of stack is the String" - | deviceName obj srcPtr sz | + | deviceName obj srcPtr sz | + self cCode: [] inSmalltalk: [deviceName := ByteString new: 257]. - "Parse arguments" interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. + ((interpreterProxy isBytes: (obj := interpreterProxy stackValue: 0)) + and: [(sz := interpreterProxy byteSizeOf: obj) <= 256]) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + + srcPtr := self cCoerce: (interpreterProxy firstIndexableField: obj) to: #'char *'. + self strncpy: deviceName _: srcPtr _: sz. + deviceName at: sz put: 0. + self setDefaultSoundPlayer: deviceName. + + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnReceiver]! - [^interpreterProxy primitiveFail]. - obj := interpreterProxy stackValue: 0. - (interpreterProxy isBytes: obj) ifFalse: - [^interpreterProxy primitiveFail]. - (sz := interpreterProxy byteSizeOf: obj) <= 256 ifFalse: - [^interpreterProxy primitiveFail]. - srcPtr := interpreterProxy firstIndexableField: obj. - self touch: srcPtr. - self touch: deviceName. - self touch: sz. - self cCode: 'strncpy(deviceName, srcPtr, sz)'. - self cCode: 'deviceName[sz] = 0'. - - "do the work" - self cCode: 'setDefaultSoundPlayer(deviceName)'. - interpreterProxy failed ifFalse: "pop arg, leave receiver" - [interpreterProxy pop: 1]! Item was changed: ----- Method: SoundPlugin>>primitiveSetDefaultSoundRecorder (in category 'primitives') ----- primitiveSetDefaultSoundRecorder "Tell the operating system to use the specified device name as the input device for sound." "arg at top of stack is the String" - | deviceName obj srcPtr sz | + | deviceName obj srcPtr sz | + self cCode: [] inSmalltalk: [deviceName := ByteString new: 257]. - "Parse arguments" interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. + ((interpreterProxy isBytes: (obj := interpreterProxy stackValue: 0)) + and: [(sz := interpreterProxy byteSizeOf: obj) <= 256]) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + + srcPtr := self cCoerce: (interpreterProxy firstIndexableField: obj) to: #'char *'. + self strncpy: deviceName _: srcPtr _: sz. + deviceName at: sz put: 0. + self setDefaultSoundRecorder: deviceName. + + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnReceiver]! - [^interpreterProxy primitiveFail]. - obj := interpreterProxy stackValue: 0. - (interpreterProxy isBytes: obj) ifFalse: - [^interpreterProxy primitiveFail]. - (sz := interpreterProxy byteSizeOf: obj) <= 256 ifFalse: - [^interpreterProxy primitiveFail]. - srcPtr := interpreterProxy firstIndexableField: obj. - self touch: srcPtr. - self touch: deviceName. - self touch: sz. - self cCode: 'strncpy(deviceName, srcPtr, sz)'. - self cCode: 'deviceName[sz] = 0'. - - "do the work" - self cCode: 'setDefaultSoundRecorder(deviceName)'. - interpreterProxy failed ifFalse: "pop arg, leave receiver" - [interpreterProxy pop: 1]! Item was changed: ----- Method: SoundPlugin>>primitiveSoundAvailableSpace (in category 'primitives') ----- primitiveSoundAvailableSpace + "Returns the number of bytes of available sound output buffer space. + This should be (frames*4) if the device is in stereo mode, or (frames*2) otherwise" - "Returns the number of bytes of available sound output buffer space. This should be (frames*4) if the device is in stereo mode, or (frames*2) otherwise" + | frames | + frames := self snd_AvailableSpace. "-1 if sound output not started" + frames >= 0 + ifTrue: [interpreterProxy methodReturnInteger: frames] + ifFalse: [interpreterProxy primitiveFail]! - self primitive: 'primitiveSoundAvailableSpace'. - frames := self cCode: 'snd_AvailableSpace()'. "-1 if sound output not started" - interpreterProxy success: frames >= 0. - ^frames asPositiveIntegerObj! Item was added: + ----- Method: SoundPlugin>>primitiveSoundEnableAEC (in category 'primitives') ----- + primitiveSoundEnableAEC + "Enable or disable acoustic echo-cancellation (AEC). + Arg is a boolean or 1 for true and 0 for false." + + | arg trueOrFalse errorCode | + interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. + "Parse arguments" + (interpreterProxy isIntegerObject: (arg := interpreterProxy stackValue: 0)) + ifTrue: + [arg := interpreterProxy integerValueOf: arg. + (interpreterProxy cCoerce: arg to: #unsigned) > 1 ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + trueOrFalse := arg = 1] + ifFalse: + [(interpreterProxy isBooleanObject: arg) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + trueOrFalse := interpreterProxy booleanValueOf: arg]. + "Set AEC" + (errorCode := self snd_EnableAEC: trueOrFalse) ~= 0 ifTrue: + [interpreterProxy primitiveFailFor: (errorCode < 0 ifTrue: [PrimErrGenericFailure] ifFalse: [errorCode])]! Item was removed: - ----- Method: SoundPlugin>>primitiveSoundEnableAEC: (in category 'primitives') ----- - primitiveSoundEnableAEC: trueOrFalse - "Enable or disable acoustic echo-cancellation (AEC). trueOrFalse should be 0 for false, and 1 for true." - | result | - self primitive: 'primitiveSoundEnableAEC' parameters: #(SmallInteger ). - interpreterProxy failed ifFalse: [ - result := self cCode: 'snd_EnableAEC(trueOrFalse)'. - result == 0 ifFalse: [interpreterProxy primitiveFailFor: result]. - ].! Item was changed: ----- Method: SoundPlugin>>primitiveSoundGetRecordLevel (in category 'primitives') ----- primitiveSoundGetRecordLevel + "Get the default input device's volume level in the range 0-1000." + - "Get the sound input recording level in the range 0-1000." | level | + level := self snd_GetRecordLevel. + ^level >= 0 + ifTrue: [interpreterProxy methodReturnInteger: level] + ifFalse: [interpreterProxy primitiveFail]! - self primitive: 'primitiveSoundGetRecordLevel'. - level := self cCode: 'snd_GetRecordLevel()'. - ^level asPositiveIntegerObj - ! Item was changed: ----- Method: SoundPlugin>>primitiveSoundGetRecordingSampleRate (in category 'primitives') ----- primitiveSoundGetRecordingSampleRate "Return a float representing the actual sampling rate during recording. Fail if not currently recording." + | rate | + + rate := self snd_GetRecordingSampleRate. "fails if not recording" + interpreterProxy failed ifFalse: + [^interpreterProxy methodReturnFloat: rate]! - - self primitive: 'primitiveSoundGetRecordingSampleRate'. - rate := self cCode: 'snd_GetRecordingSampleRate()'. "fail if not recording" - ^rate asFloatObj! Item was changed: ----- Method: SoundPlugin>>primitiveSoundGetVolume (in category 'primitives') ----- primitiveSoundGetVolume + "Get the default output device's volume level as a left/right pair of floats in the range 0-1." + + | left right leftOop rightOop results | - "Get the sound input recording level." - | left right results | + left := 0.0. + right := 0.0. + self snd_Volume: (self addressOf: left put: [:v| left := v]) _: (self addressOf: right put: [:v| right := v]). + interpreterProxy failed ifTrue: + [^self]. + results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. + results ifNil: + [^interpreterProxy primitiveFailFor: PrimErrNoMemory]. + self remapOop: results in: + [leftOop := interpreterProxy floatObjectOf: left. + self remapOop: leftOop in: + [rightOop := interpreterProxy floatObjectOf: right]]. + interpreterProxy + storePointer: 0 ofObject: results withValue: leftOop; + storePointer: 1 ofObject: results withValue: rightOop; + methodReturnValue: results! - self primitive: 'primitiveSoundGetVolume' - parameters: #( ). - left := 0. - right := 0. - self cCode: 'snd_Volume((double *) &left,(double *) &right)'. - interpreterProxy pushRemappableOop: (right asOop: Float). - interpreterProxy pushRemappableOop: (left asOop: Float). - results := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2. - interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop. - interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop. - ^results! Item was changed: ----- Method: SoundPlugin>>primitiveSoundInsertSamples:from:leadTime: (in category 'primitives') ----- primitiveSoundInsertSamples: frameCount from: buf leadTime: leadTime "Insert a buffer's worth of sound samples into the currently playing buffer. Used to make a sound start playing as quickly as possible. The new sound is mixed with the previously buffered sampled." "Details: Unlike primitiveSoundPlaySamples, this primitive always starts with the first sample the given sample buffer. Its third argument specifies the number of samples past the estimated sound output buffer position the inserted sound should start. If successful, it returns the number of samples inserted." | framesPlayed | self primitive: 'primitiveSoundInsertSamples' + parameters: #(SmallInteger WordArray SmallInteger). + frameCount <= (interpreterProxy slotSizeOf: buf cPtrAsOop) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - parameters: #(SmallInteger WordArray SmallInteger ). - interpreterProxy success: frameCount <= (interpreterProxy slotSizeOf: buf cPtrAsOop). + framesPlayed := self snd_InsertSamplesFromLeadTime: frameCount _: buf _: leadTime. + framesPlayed >= 0 + ifTrue: [interpreterProxy methodReturnInteger: framesPlayed] + ifFalse: [interpreterProxy primitiveFail]! - interpreterProxy failed - ifFalse: [framesPlayed := self cCode: 'snd_InsertSamplesFromLeadTime(frameCount, (void *)buf, leadTime)'. - interpreterProxy success: framesPlayed >= 0]. - ^ framesPlayed asPositiveIntegerObj! Item was changed: ----- Method: SoundPlugin>>primitiveSoundPlaySamples:from:startingAt: (in category 'primitives') ----- primitiveSoundPlaySamples: frameCount from: buf startingAt: startIndex "Output a buffer's worth of sound samples." | framesPlayed | self primitive: 'primitiveSoundPlaySamples' + parameters: #(SmallInteger WordArray SmallInteger). + (startIndex >= 1 and: [startIndex + frameCount - 1 <= (interpreterProxy slotSizeOf: buf cPtrAsOop)]) ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - parameters: #(SmallInteger WordArray SmallInteger ). - interpreterProxy success: (startIndex >= 1 and: [startIndex + frameCount - 1 <= (interpreterProxy slotSizeOf: buf cPtrAsOop)]). + framesPlayed := self snd_PlaySamplesFromAtLength: frameCount _: buf _: startIndex - 1. + framesPlayed >= 0 + ifTrue: [interpreterProxy methodReturnInteger: framesPlayed] + ifFalse: [interpreterProxy primitiveFail]! - interpreterProxy failed - ifFalse: [framesPlayed := self cCode: 'snd_PlaySamplesFromAtLength(frameCount, (void *)buf, startIndex - 1)'. - interpreterProxy success: framesPlayed >= 0]. - ^ framesPlayed asPositiveIntegerObj! Item was changed: ----- Method: SoundPlugin>>primitiveSoundPlaySilence (in category 'primitives') ----- primitiveSoundPlaySilence "Output a buffer's worth of silence. Returns the number of sample frames played." + | framesPlayed | + framesPlayed := self snd_PlaySilence. "-1 if sound output not started" + framesPlayed >= 0 + ifTrue: [interpreterProxy methodReturnInteger: framesPlayed] + ifFalse: [interpreterProxy primitiveFail]! - self primitive: 'primitiveSoundPlaySilence'. - framesPlayed := self cCode: 'snd_PlaySilence()'. "-1 if sound output not started" - interpreterProxy success: framesPlayed >= 0. - ^framesPlayed asPositiveIntegerObj! Item was changed: ----- Method: SoundPlugin>>primitiveSoundRecordSamplesInto:startingAt: (in category 'primitives') ----- primitiveSoundRecordSamplesInto: buf startingAt: startWordIndex "Record a buffer's worth of 16-bit sound samples." + | bufSizeInBytes samplesRecorded bufPtr byteOffset | - | bufSizeInBytes samplesRecorded bufPtr byteOffset bufLen | self primitive: 'primitiveSoundRecordSamples' + parameters: #(WordArray SmallInteger). - parameters: #(WordArray SmallInteger ). + bufSizeInBytes := (interpreterProxy slotSizeOf: buf cPtrAsOop) * 4. + byteOffset := (startWordIndex - 1) * 2. - interpreterProxy failed ifFalse: - [bufSizeInBytes := (interpreterProxy slotSizeOf: buf cPtrAsOop) * 4. - interpreterProxy success: (startWordIndex >= 1 and: [startWordIndex - 1 * 2 < bufSizeInBytes])]. + (startWordIndex >= 1 and: [byteOffset < bufSizeInBytes]) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. - interpreterProxy failed ifFalse:[ - byteOffset := (startWordIndex - 1) * 2. - bufPtr := (self cCoerce: buf to: 'char*') + byteOffset. - bufLen := bufSizeInBytes - byteOffset. - samplesRecorded := self cCode: 'snd_RecordSamplesIntoAtLength(bufPtr, 0, bufLen)' inSmalltalk:[bufPtr. bufLen. 0]. - ]. + bufPtr := (self cCoerce: buf to: #'char *') + byteOffset. + samplesRecorded := self snd_RecordSamplesIntoAtLength: bufPtr _: 0 _: bufSizeInBytes - byteOffset. + interpreterProxy failed ifFalse: + [^samplesRecorded asPositiveIntegerObj]! - ^ samplesRecorded asPositiveIntegerObj! Item was changed: ----- Method: SoundPlugin>>primitiveSoundSetLeftVolume:rightVolume: (in category 'primitives') ----- primitiveSoundSetLeftVolume: aLeftVolume rightVolume: aRightVolume "Set the sound input recording level." self primitive: 'primitiveSoundSetLeftVolume' parameters: #(Float Float). + self snd_SetVolume: aLeftVolume _: aRightVolume! - interpreterProxy failed ifFalse: [self cCode: 'snd_SetVolume(aLeftVolume,aRightVolume)']. - ! Item was changed: ----- Method: SoundPlugin>>primitiveSoundSetRecordLevel: (in category 'primitives') ----- primitiveSoundSetRecordLevel: level "Set the sound input recording level." self primitive: 'primitiveSoundSetRecordLevel' + parameters: #(SmallInteger). + self snd_SetRecordLevel: level! - parameters: #(SmallInteger ). - interpreterProxy failed ifFalse: [self cCode: 'snd_SetRecordLevel(level)']! Item was changed: ----- Method: SoundPlugin>>primitiveSoundStartBufferSize:rate:stereo: (in category 'primitives') ----- primitiveSoundStartBufferSize: bufFrames rate: samplesPerSec stereo: stereoFlag "Start the double-buffered sound output with the given buffer size, sample rate, and stereo flag." self primitive: 'primitiveSoundStart' parameters: #(SmallInteger SmallInteger Boolean). + interpreterProxy success: (self snd_Start: bufFrames _: samplesPerSec _: stereoFlag _: 0)! - interpreterProxy success: (self cCode: 'snd_Start(bufFrames, samplesPerSec, stereoFlag, 0)')! Item was changed: ----- Method: SoundPlugin>>primitiveSoundStartBufferSize:rate:stereo:semaIndex: (in category 'primitives') ----- primitiveSoundStartBufferSize: bufFrames rate: samplesPerSec stereo: stereoFlag semaIndex: semaIndex "Start the double-buffered sound output with the given buffer size, sample rate, stereo flag, and semaphore index." self primitive: 'primitiveSoundStartWithSemaphore' parameters: #(SmallInteger SmallInteger Boolean SmallInteger). + interpreterProxy success: (self snd_Start: bufFrames _: samplesPerSec _: stereoFlag _: semaIndex)! - interpreterProxy success: (self cCode: 'snd_Start(bufFrames, samplesPerSec, stereoFlag, semaIndex)')! Item was changed: ----- Method: SoundPlugin>>primitiveSoundStartRecordingDesiredSampleRate:stereo:semaIndex: (in category 'primitives') ----- primitiveSoundStartRecordingDesiredSampleRate: desiredSamplesPerSec stereo: stereoFlag semaIndex: semaIndex "Start recording sound with the given parameters." self primitive: 'primitiveSoundStartRecording' parameters: #(SmallInteger Boolean SmallInteger). + self snd_StartRecording: desiredSamplesPerSec _: stereoFlag _: semaIndex! - self cCode: 'snd_StartRecording(desiredSamplesPerSec, stereoFlag, semaIndex)'! Item was changed: ----- Method: SoundPlugin>>primitiveSoundStop (in category 'primitives') ----- primitiveSoundStop "Stop double-buffered sound output." + + self snd_Stop! - - self primitive: 'primitiveSoundStop'. - - self cCode: 'snd_Stop()'. "leave rcvr on stack"! Item was changed: ----- Method: SoundPlugin>>primitiveSoundStopRecording (in category 'primitives') ----- primitiveSoundStopRecording "Stop recording sound." + + self snd_StopRecording! - - self primitive: 'primitiveSoundStopRecording'. - self cCode: 'snd_StopRecording()'. "leave rcvr on stack"! Item was changed: ----- Method: SoundPlugin>>primitiveSoundSupportsAEC (in category 'primitives') ----- primitiveSoundSupportsAEC + "Answer if the OS/hardware supports echo-cancellation." + - "Answer true if the OS/hardware supports echo-cancellation, and false otherwise." | result | + result := self snd_SupportsAEC. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnBool: result ~= 0]! - self primitive: 'primitiveSoundSupportsAEC'. - interpreterProxy failed ifFalse: [ - result := self cCode: 'snd_SupportsAEC()'. - result == 0 ifTrue: [^interpreterProxy falseObject] ifFalse: [^interpreterProxy trueObject] - ]. - ! Item was changed: ----- Method: VMClass>>cCoerce:to: (in category 'memory access') ----- cCoerce: value to: cTypeString + "Type coercion. For translation a cast will be emitted. When running in Smalltalk - "Type coercion. For translation a cast will be emmitted. When running in Smalltalk answer a suitable wrapper for correct indexing." ^value ifNil: [value] ifNotNil: [value coerceTo: cTypeString sim: self]! Item was changed: ----- Method: VMPluginCodeGenerator>>shouldGenerateAsInterpreterProxySend: (in category 'utilities') ----- shouldGenerateAsInterpreterProxySend: aSendNode "Answer if this send should be generated as interpreterProxy->foo or its moral equivalent (*). (*) since we now use function pointers declared in each external plugin we only indirect through interopreterProxy at plugin initialization. But we still have to find the set of sends a plugin uses." | selector | (aSendNode receiver isVariable and: ['interpreterProxy' = aSendNode receiver name]) ifFalse: [^false]. selector := aSendNode selector. "baseHeaderSize, minSmallInteger et al are #defined in each VM's interp.h" (VMBasicConstants mostBasicConstantSelectors includes: selector) ifTrue: [^false]. "Only include genuine InterpreterProxy methods, excluding things not understood + by InterpreterProxy and things in its initialize, private and simulation protocols." + ^(#(initialize private #'simulation only') includes: (InterpreterProxy compiledMethodAt: selector ifAbsent: [^false]) protocol) not! - by InterpreterProxy and things in its initialize and private protocols." - ^(#(initialize private) includes: (InterpreterProxy compiledMethodAt: selector ifAbsent: [^false]) protocol) not! From noreply at github.com Sat Aug 1 03:05:20 2020 From: noreply at github.com (Eliot Miranda) Date: Fri, 31 Jul 2020 20:05:20 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 3e9a53: CogVM source as per VMMaker.oscog-eem.2785 Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 3e9a53515b3f28f7de45e587447028f9eddadc0e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/3e9a53515b3f28f7de45e587447028f9eddadc0e Author: Eliot Miranda Date: 2020-07-31 (Fri, 31 Jul 2020) Changed paths: M nsspur64src/vm/cogit.h M nsspur64src/vm/cogitARMv8.c M nsspur64src/vm/cogitX64SysV.c M nsspur64src/vm/cogitX64WIN64.c M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cogitARMv5.c M nsspursrc/vm/cogitIA32.c M nsspursrc/vm/cogitMIPSEL.c M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.m M spur64src/vm/cogit.h M spur64src/vm/cogitARMv8.c M spur64src/vm/cogitX64SysV.c M spur64src/vm/cogitX64WIN64.c M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cogit.h M spurlowcode64src/vm/cogitARMv8.c M spurlowcode64src/vm/cogitX64SysV.c M spurlowcode64src/vm/cogitX64WIN64.c M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cogit.h M spurlowcodesrc/vm/cogitARMv5.c M spurlowcodesrc/vm/cogitIA32.c M spurlowcodesrc/vm/cogitMIPSEL.c M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spurlowcodestack64src/vm/gcc3x-interp.c M spurlowcodestack64src/vm/interp.c M spurlowcodestacksrc/vm/gcc3x-interp.c M spurlowcodestacksrc/vm/interp.c M spursista64src/vm/cogit.h M spursista64src/vm/cogitARMv8.c M spursista64src/vm/cogitX64SysV.c M spursista64src/vm/cogitX64WIN64.c M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cogitARMv5.c M spursistasrc/vm/cogitIA32.c M spursistasrc/vm/cogitMIPSEL.c M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cogitARMv5.c M spursrc/vm/cogitIA32.c M spursrc/vm/cogitMIPSEL.c M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstack64src/vm/validImage.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M spurstacksrc/vm/validImage.c M src/plugins/BitBltPlugin/BitBltPlugin.c M src/plugins/FileAttributesPlugin/FileAttributesPlugin.c M src/plugins/FilePlugin/FilePlugin.c M src/plugins/IA32ABI/IA32ABI.c M src/plugins/JPEGReadWriter2Plugin/JPEGReadWriter2Plugin.c M src/plugins/SocketPlugin/SocketPlugin.c M src/plugins/SoundPlugin/SoundPlugin.c M src/vm/cogit.h M src/vm/cogitARMv5.c M src/vm/cogitIA32.c M src/vm/cogitMIPSEL.c M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c M stacksrc/vm/gcc3x-interp.c M stacksrc/vm/interp.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.2785 Plugins: Clean up the SoundPlugin, eliminating almost all cCode:'s, making it potentially simulateable once the internal API is implemented. Use the methodRetur...: API to simplify a number of primitives. Change primitiveSoundEnableAEC to take either 0, 1 or a boolean. Fix a bad bug in the Mac SoundPlgin support. The default input and output devices were switched so the names answered were interchanged (!!). Fix a bug setting the device volume; it simply has to follow the scheme used for getting the volume. Slang: eliminate the arguments to addressOf:put: blocks, hence getting rid of quite a few unused valiables. From builds at travis-ci.org Sat Aug 1 03:26:00 2020 From: builds at travis-ci.org (Travis CI) Date: Sat, 01 Aug 2020 03:26:00 +0000 Subject: [Vm-dev] Errored: OpenSmalltalk/opensmalltalk-vm#2128 (Cog - 3e9a535) In-Reply-To: Message-ID: <5f24e0c7d47da_13f90dacd28f0214973@travis-tasks-5877d46bf6-xlw2g.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2128 Status: Errored Duration: 20 mins and 12 secs Commit: 3e9a535 (Cog) Author: Eliot Miranda Message: CogVM source as per VMMaker.oscog-eem.2785 Plugins: Clean up the SoundPlugin, eliminating almost all cCode:'s, making it potentially simulateable once the internal API is implemented. Use the methodRetur...: API to simplify a number of primitives. Change primitiveSoundEnableAEC to take either 0, 1 or a boolean. Fix a bad bug in the Mac SoundPlgin support. The default input and output devices were switched so the names answered were interchanged (!!). Fix a bug setting the device volume; it simply has to follow the scheme used for getting the volume. Slang: eliminate the arguments to addressOf:put: blocks, hence getting rid of quite a few unused valiables. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/1492758f44d4...3e9a53515b3f View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/713901940?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From no-reply at appveyor.com Sat Aug 1 04:02:25 2020 From: no-reply at appveyor.com (AppVeyor) Date: Sat, 01 Aug 2020 04:02:25 +0000 Subject: [Vm-dev] Build failed: opensmalltalk-vm 1.0.2126 Message-ID: <20200801040225.1.A9460B217CA7B561@appveyor.com> An HTML attachment was scrubbed... URL: From tim at rowledge.org Sat Aug 1 17:08:18 2020 From: tim at rowledge.org (tim Rowledge) Date: Sat, 1 Aug 2020 10:08:18 -0700 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2785.mcz In-Reply-To: References: Message-ID: <94076715-B34F-41EB-A0AF-ED5EA54BF630@rowledge.org> > Use the methodRetur...: API to simplify a number of primitives. Ooh, I like that change. But it needs to be read in a "Bobby Llewellyn making silly voice" to really get the effect. If you don't know Bobby Llewellyn you need to a) watch some Red Dwarf b) watch some recent 'Fully Charged' episodes on yootoob in order to get the reference and style. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Propaganda: a good look From karlramberg at gmail.com Sat Aug 1 18:41:32 2020 From: karlramberg at gmail.com (karl ramberg) Date: Sat, 1 Aug 2020 20:41:32 +0200 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2785.mcz In-Reply-To: References: Message-ID: Cool. I've seen people asking about higher bit depth in Sound plugin. Maybe that will be easier to add now ? Best, Karl On Sat, Aug 1, 2020 at 4:45 AM wrote: > > Eliot Miranda uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2785.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-eem.2785 > Author: eem > Time: 31 July 2020, 7:45:15.985473 pm > UUID: 9fa77ef1-7255-47f3-9dd1-c500f9529cbb > Ancestors: VMMaker.oscog-eem.2784 > > Plugins: Clean up the SoundPlugin, eloiminating almost all cCode:'s, > making it potentially simulateable once the internal API is implemented. > Use the methodRetur...: API to simplify a number of primitives. Change > primitiveSoundEnableAEC to take either 0, 1 or a boolean. > > Slang: eliminate the arguments to addressOf:put: blocks via > nodeIsDeadCode:withParent: > > Simulation: implement unsigned coercion in cCoerce:to: to support this > form in primitiveSoundEnableAEC > (interpreterProxy isIntegerObject: (arg := interpreterProxy > stackValue: 0)) > ifTrue: > [arg := interpreterProxy integerValueOf: arg. > (interpreterProxy cCoerce: arg to: #unsigned) > 1 > ifTrue: > [^interpreterProxy primitiveFailFor: > PrimErrBadArgument]. > trueOrFalse := arg = 1] > ifFalse: > [(interpreterProxy isBooleanObject: arg) ifFalse: > [^interpreterProxy primitiveFailFor: > PrimErrBadArgument]. > trueOrFalse := interpreterProxy booleanValueOf: > arg]. > > =============== Diff against VMMaker.oscog-eem.2784 =============== > > Item was changed: > ----- Method: CCodeGenerator>>nodeIsDeadCode:withParent: (in category > 'utilities') ----- > nodeIsDeadCode: aNode withParent: parentNode > "Answer if aNode would not be generated due to dead code > elimination." > + (aNode isLiteralBlock and: [parentNode isSend and: [parentNode > selector == #addressOf:put:]]) ifTrue: > + [^true]. > ^(self nilOrBooleanConditionFor: parentNode) > ifNil: [false] > ifNotNil: > [:cond| | filter | > filter := parentNode selector caseOf: > { "First element > is accessor for filtered (eliminated) node if expression is true. > Second > element is accessor for filtered (eliminated) node if expression is false." > > [#ifFalse:] -> [#(first nil)]. > > [#ifFalse:ifTrue:] -> [#(first last)]. > > [#ifTrue:] -> [#(nil first)]. > > [#ifTrue:ifFalse:] -> [#(last first)]. > [#and:] > -> [#(nil first)]. > [#or:] > -> [#(last nil)]. > > [#cppIf:ifTrue:] -> [#(nil #second)]. > > [#cppIf:ifTrue:ifFalse:] -> [#(third #second)] }. > (cond ifTrue: [filter first] ifFalse: [filter > last]) > ifNil: [false] > ifNotNil: [:accessor| aNode == (parentNode > args perform: accessor)]]! > > Item was changed: > ----- Method: Integer>>coerceTo:sim: (in category '*VMMaker-interpreter > simulator') ----- > coerceTo: cTypeString sim: interpreter > > | unitSize | > + cTypeString last == $* ifTrue: "C pointer" > - cTypeString last = $* ifTrue: "C pointer" > [unitSize := cTypeString caseOf: { > [#'char *'] -> [1]. > [#'short *'] -> [2]. > [#'int *'] -> [4]. > [#'long long *'] -> [8]. > [#'float *'] -> [^CFloatArray basicNew interpreter: > interpreter address: self unitSize: 4; yourself]. > [#'double *'] -> [^CFloatArray basicNew interpreter: > interpreter address: self unitSize: 8; yourself]. > [#'unsigned *'] -> [4]. > [#'unsigned int *'] -> [4]. > [#'unsigned char *'] -> [1]. > [#'signed char *'] -> [1]. > [#'unsigned short *'] -> [2]. > [#'unsigned long long *'] -> [8]. > [#'oop *'] -> [interpreter objectMemory bytesPerOop]. > } > otherwise: [interpreter objectMemory wordSize]. > ^CArray basicNew > interpreter: interpreter address: self unitSize: > unitSize; > yourself]. > + cTypeString first == $u ifTrue: > + [unitSize := cTypeString caseOf: { > + [#usqInt] -> [interpreter objectMemory wordSize]. > + [#usqLong] -> [8]. > + [#unsigned] -> [4]. > + [#'unsigned int'] -> [4]. > + [#'unsigned char'] -> [1]. > + [#'unsigned long'] -> [6]. > + [#'unsigned short'] -> [2]. > + [#'unsigned long long'] -> [8]. > + } > + otherwise: [self error: 'unknown unsigned type name']. > + ^self bitAnd: 1 << (8 * unitSize) - 1]. > + ^self "C number (int, char, etc)"! > - ^self "C number (int, char, float, etc)"! > > Item was added: > + ----- Method: InterpreterProxy>>cCoerce:to: (in category 'simulation > only') ----- > + cCoerce: value to: cTypeString > + "Type coercion. For translation a cast will be emitted. When > running in Smalltalk > + answer a suitable wrapper for correct indexing." > + ^value > + ifNil: [value] > + ifNotNil: [value coerceTo: cTypeString sim: self]! > > Item was changed: > ----- Method: RePlugin>>rcvrMatchSpacePtr (in category 'rcvr linkage') > ----- > rcvrMatchSpacePtr > > > > ^self > cCoerce: (interpreterProxy fetchArray: 7 ofObject: rcvr) > + to: #'int *'! > - to: 'int *'.! > > Item was changed: > ----- Method: RePlugin>>rcvrPatternStrPtr (in category 'rcvr linkage') > ----- > rcvrPatternStrPtr > > > > ^self > cCoerce: (interpreterProxy fetchArray: 0 ofObject: rcvr) > + to: #'char *'.! > - to: 'char *'.! > > Item was changed: > ----- Method: SoundPlugin>>primitiveGetDefaultSoundPlayer (in category > 'primitives') ----- > primitiveGetDefaultSoundPlayer > "Answer a String with the operating system name of the default > output device, or nil" > "no arguments" > - | cDeviceName sz newString newStringPtr | > > + | cDeviceName | > + > - > - > > - "Parse arguments" > - interpreterProxy methodArgumentCount = 0 > - ifFalse:[^interpreterProxy primitiveFail]. > - > "Get the answer." > + cDeviceName := self getDefaultSoundPlayer. > + cDeviceName = 0 ifTrue: > + [^interpreterProxy methodReturnValue: interpreterProxy > nilObject]. > - cDeviceName := self cCode: 'getDefaultSoundPlayer()'. > - cDeviceName == 0 ifTrue: [ > - ^interpreterProxy pop: 1 thenPush: interpreterProxy > nilObject > - ]. > > + ^interpreterProxy methodReturnString: cDeviceName! > - "Copy the answer to a Squeak String." > - sz := self cCode: 'strlen(cDeviceName)'. > - newString := interpreterProxy > - > instantiateClass: interpreterProxy classString > - > indexableSize: sz. > - newStringPtr := interpreterProxy firstIndexableField: newString. > - self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'. > - > - self touch: newStringPtr. > - self touch: cDeviceName. > - "Pop the receiver, and answer the new string." > - ^interpreterProxy pop: 1 thenPush: newString! > > Item was changed: > ----- Method: SoundPlugin>>primitiveGetDefaultSoundRecorder (in category > 'primitives') ----- > primitiveGetDefaultSoundRecorder > "Answer a String with the operating system name of the default > input device, or nil" > "no arguments" > - | cDeviceName sz newString newStringPtr | > > + | cDeviceName | > + > - > - > > - "Parse arguments" > - interpreterProxy methodArgumentCount = 0 > - ifFalse:[^interpreterProxy primitiveFail]. > - > "Get the answer." > + cDeviceName := self getDefaultSoundRecorder. > + cDeviceName = 0 ifTrue: > + [^interpreterProxy methodReturnValue: interpreterProxy > nilObject]. > - cDeviceName := self cCode: 'getDefaultSoundRecorder()'. > - cDeviceName == 0 ifTrue: [ > - ^interpreterProxy pop: 1 thenPush: interpreterProxy > nilObject > - ]. > > + ^interpreterProxy methodReturnString: cDeviceName! > - "Copy the answer to a Squeak String." > - sz := self cCode: 'strlen(cDeviceName)'. > - newString := interpreterProxy > - > instantiateClass: interpreterProxy classString > - > indexableSize: sz. > - newStringPtr := interpreterProxy firstIndexableField: newString. > - self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'. > - > - self touch: newStringPtr. > - self touch: cDeviceName. > - "Pop the receiver, and answer the new string." > - ^interpreterProxy pop: 1 thenPush: newString! > > Item was changed: > ----- Method: SoundPlugin>>primitiveGetNumberOfSoundPlayerDevices (in > category 'primitives') ----- > primitiveGetNumberOfSoundPlayerDevices > - "arguments: name(type, stack offset) > - dialString(String, 0)" > - "answers an Integer" > - | result | > > > + ^interpreterProxy methodReturnInteger: self > getNumberOfSoundPlayerDevices! > - "Parse arguments" > - interpreterProxy methodArgumentCount = 0 > - ifFalse:[^interpreterProxy primitiveFail]. > - > - "get result" > - result := self cCode: 'getNumberOfSoundPlayerDevices()'. > - > - "answer it" > - result := interpreterProxy signed32BitIntegerFor: result. > - ^interpreterProxy pop: 1 thenPush: result. "pop receiver, return > result"! > > Item was changed: > ----- Method: SoundPlugin>>primitiveGetNumberOfSoundRecorderDevices (in > category 'primitives') ----- > primitiveGetNumberOfSoundRecorderDevices > - "arguments: name(type, stack offset) > - dialString(String, 0)" > - "answers an Integer" > - | result | > > > + ^interpreterProxy methodReturnInteger: self > getNumberOfSoundRecorderDevices! > - "Parse arguments" > - interpreterProxy methodArgumentCount = 0 > - ifFalse:[^interpreterProxy primitiveFail]. > - > - "get result" > - result := self cCode: 'getNumberOfSoundRecorderDevices()'. > - > - "answer it" > - result := interpreterProxy signed32BitIntegerFor: result. > - ^interpreterProxy pop: 1 thenPush: result. "pop receiver, return > result"! > > Item was changed: > ----- Method: SoundPlugin>>primitiveGetSoundPlayerDeviceName (in > category 'primitives') ----- > primitiveGetSoundPlayerDeviceName > "arguments: name(type, stack offset) > deviceNumber(Integer, 0)" > "answers a string or nil" > - | deviceNumber sz cDeviceName newString newStringPtr | > > + | deviceNumber cDeviceName | > + > - > - > > "Parse arguments" > + interpreterProxy methodArgumentCount = 1 ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. > - interpreterProxy methodArgumentCount = 1 > - ifFalse:[^interpreterProxy primitiveFail]. > > deviceNumber := interpreterProxy positive32BitValueOf: > (interpreterProxy stackValue: 0). > + interpreterProxy failed ifTrue: > + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. > - interpreterProxy failed ifTrue: [^nil]. > > "Get the answer." > + cDeviceName := self getSoundPlayerDeviceName: deviceNumber - 1. > + cDeviceName = 0 ifTrue: > + [^interpreterProxy methodReturnValue: interpreterProxy > nilObject]. > - cDeviceName := self cCode: 'getSoundPlayerDeviceName(deviceNumber > - 1)'. > - cDeviceName == 0 ifTrue: [ > - ^interpreterProxy pop: 2 thenPush: interpreterProxy > nilObject > - ]. > > + ^interpreterProxy methodReturnString: cDeviceName! > - "Copy the answer to a Squeak String." > - sz := self cCode: 'strlen(cDeviceName)'. > - newString := interpreterProxy > - > instantiateClass: interpreterProxy classString > - > indexableSize: sz. > - newStringPtr := interpreterProxy firstIndexableField: newString. > - self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'. > - > - self touch: deviceNumber. > - self touch: newStringPtr. > - self touch: cDeviceName. > - "Pop the receiver and arg, and answer the new string." > - ^interpreterProxy pop: 2 thenPush: newString! > > Item was changed: > ----- Method: SoundPlugin>>primitiveGetSoundRecorderDeviceName (in > category 'primitives') ----- > primitiveGetSoundRecorderDeviceName > "arguments: name(type, stack offset) > deviceNumber(Integer, 0)" > "answers a string or nil" > - | deviceNumber sz cDeviceName newString newStringPtr | > > + | deviceNumber cDeviceName | > + > - > - > > "Parse arguments" > + interpreterProxy methodArgumentCount = 1 ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. > - interpreterProxy methodArgumentCount = 1 > - ifFalse:[^interpreterProxy primitiveFail]. > > - > deviceNumber := interpreterProxy positive32BitValueOf: > (interpreterProxy stackValue: 0). > + interpreterProxy failed ifTrue: > + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. > - interpreterProxy failed ifTrue: [^nil]. > > "Get the answer." > + cDeviceName := self getSoundRecorderDeviceName: deviceNumber - 1. > + cDeviceName = 0 ifTrue: > + [^interpreterProxy methodReturnValue: interpreterProxy > nilObject]. > - cDeviceName := self cCode: > 'getSoundRecorderDeviceName(deviceNumber - 1)'. > - cDeviceName == 0 ifTrue: [ > - ^interpreterProxy pop: 2 thenPush: interpreterProxy > nilObject > - ]. > > + ^interpreterProxy methodReturnString: cDeviceName! > - "Copy the answer to a Squeak String." > - sz := self cCode: 'strlen(cDeviceName)'. > - newString := interpreterProxy > - > instantiateClass: interpreterProxy classString > - > indexableSize: sz. > - newStringPtr := interpreterProxy firstIndexableField: newString. > - self cCode: 'strncpy(newStringPtr, cDeviceName, sz)'. > - > - self touch: deviceNumber. > - self touch: newStringPtr. > - self touch: cDeviceName. > - "Pop the receiver and arg, and answer the new string." > - ^interpreterProxy pop: 2 thenPush: newString! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSetDefaultSoundPlayer (in category > 'primitives') ----- > primitiveSetDefaultSoundPlayer > "Tell the operating system to use the specified device name as the > output device for sound." > "arg at top of stack is the String" > - | deviceName obj srcPtr sz | > > + | deviceName obj srcPtr sz | > > > + self cCode: [] inSmalltalk: [deviceName := ByteString new: 257]. > - > "Parse arguments" > interpreterProxy methodArgumentCount = 1 ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. > + ((interpreterProxy isBytes: (obj := interpreterProxy stackValue: > 0)) > + and: [(sz := interpreterProxy byteSizeOf: obj) <= 256]) ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. > + > + srcPtr := self cCoerce: (interpreterProxy firstIndexableField: > obj) to: #'char *'. > + self strncpy: deviceName _: srcPtr _: sz. > + deviceName at: sz put: 0. > + self setDefaultSoundPlayer: deviceName. > + > + interpreterProxy failed ifFalse: > + [interpreterProxy methodReturnReceiver]! > - [^interpreterProxy primitiveFail]. > - obj := interpreterProxy stackValue: 0. > - (interpreterProxy isBytes: obj) ifFalse: > - [^interpreterProxy primitiveFail]. > - (sz := interpreterProxy byteSizeOf: obj) <= 256 ifFalse: > - [^interpreterProxy primitiveFail]. > - srcPtr := interpreterProxy firstIndexableField: obj. > - self touch: srcPtr. > - self touch: deviceName. > - self touch: sz. > - self cCode: 'strncpy(deviceName, srcPtr, sz)'. > - self cCode: 'deviceName[sz] = 0'. > - > - "do the work" > - self cCode: 'setDefaultSoundPlayer(deviceName)'. > - interpreterProxy failed ifFalse: "pop arg, leave receiver" > - [interpreterProxy pop: 1]! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSetDefaultSoundRecorder (in category > 'primitives') ----- > primitiveSetDefaultSoundRecorder > "Tell the operating system to use the specified device name as the > input device for sound." > "arg at top of stack is the String" > - | deviceName obj srcPtr sz | > > + | deviceName obj srcPtr sz | > > > + self cCode: [] inSmalltalk: [deviceName := ByteString new: 257]. > - > "Parse arguments" > interpreterProxy methodArgumentCount = 1 ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. > + ((interpreterProxy isBytes: (obj := interpreterProxy stackValue: > 0)) > + and: [(sz := interpreterProxy byteSizeOf: obj) <= 256]) ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. > + > + srcPtr := self cCoerce: (interpreterProxy firstIndexableField: > obj) to: #'char *'. > + self strncpy: deviceName _: srcPtr _: sz. > + deviceName at: sz put: 0. > + self setDefaultSoundRecorder: deviceName. > + > + interpreterProxy failed ifFalse: > + [interpreterProxy methodReturnReceiver]! > - [^interpreterProxy primitiveFail]. > - obj := interpreterProxy stackValue: 0. > - (interpreterProxy isBytes: obj) ifFalse: > - [^interpreterProxy primitiveFail]. > - (sz := interpreterProxy byteSizeOf: obj) <= 256 ifFalse: > - [^interpreterProxy primitiveFail]. > - srcPtr := interpreterProxy firstIndexableField: obj. > - self touch: srcPtr. > - self touch: deviceName. > - self touch: sz. > - self cCode: 'strncpy(deviceName, srcPtr, sz)'. > - self cCode: 'deviceName[sz] = 0'. > - > - "do the work" > - self cCode: 'setDefaultSoundRecorder(deviceName)'. > - interpreterProxy failed ifFalse: "pop arg, leave receiver" > - [interpreterProxy pop: 1]! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundAvailableSpace (in category > 'primitives') ----- > primitiveSoundAvailableSpace > + "Returns the number of bytes of available sound output buffer > space. > + This should be (frames*4) if the device is in stereo mode, or > (frames*2) otherwise" > - "Returns the number of bytes of available sound output buffer > space. This should be (frames*4) if the device is in stereo mode, or > (frames*2) otherwise" > > + > | frames | > + frames := self snd_AvailableSpace. "-1 if sound output not > started" > + frames >= 0 > + ifTrue: [interpreterProxy methodReturnInteger: frames] > + ifFalse: [interpreterProxy primitiveFail]! > - self primitive: 'primitiveSoundAvailableSpace'. > - frames := self cCode: 'snd_AvailableSpace()'. "-1 if sound output > not started" > - interpreterProxy success: frames >= 0. > - ^frames asPositiveIntegerObj! > > Item was added: > + ----- Method: SoundPlugin>>primitiveSoundEnableAEC (in category > 'primitives') ----- > + primitiveSoundEnableAEC > + "Enable or disable acoustic echo-cancellation (AEC). > + Arg is a boolean or 1 for true and 0 for false." > + > + | arg trueOrFalse errorCode | > + interpreterProxy methodArgumentCount = 1 ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. > + "Parse arguments" > + (interpreterProxy isIntegerObject: (arg := interpreterProxy > stackValue: 0)) > + ifTrue: > + [arg := interpreterProxy integerValueOf: arg. > + (interpreterProxy cCoerce: arg to: #unsigned) > 1 > ifTrue: > + [^interpreterProxy primitiveFailFor: > PrimErrBadArgument]. > + trueOrFalse := arg = 1] > + ifFalse: > + [(interpreterProxy isBooleanObject: arg) ifFalse: > + [^interpreterProxy primitiveFailFor: > PrimErrBadArgument]. > + trueOrFalse := interpreterProxy booleanValueOf: > arg]. > + "Set AEC" > + (errorCode := self snd_EnableAEC: trueOrFalse) ~= 0 ifTrue: > + [interpreterProxy primitiveFailFor: (errorCode < 0 ifTrue: > [PrimErrGenericFailure] ifFalse: [errorCode])]! > > Item was removed: > - ----- Method: SoundPlugin>>primitiveSoundEnableAEC: (in category > 'primitives') ----- > - primitiveSoundEnableAEC: trueOrFalse > - "Enable or disable acoustic echo-cancellation (AEC). trueOrFalse > should be 0 for false, and 1 for true." > - | result | > - self primitive: 'primitiveSoundEnableAEC' parameters: > #(SmallInteger ). > - interpreterProxy failed ifFalse: [ > - result := self cCode: 'snd_EnableAEC(trueOrFalse)'. > - result == 0 ifFalse: [interpreterProxy primitiveFailFor: > result]. > - ].! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundGetRecordLevel (in category > 'primitives') ----- > primitiveSoundGetRecordLevel > + "Get the default input device's volume level in the range 0-1000." > + > - "Get the sound input recording level in the range 0-1000." > | level | > > + level := self snd_GetRecordLevel. > + ^level >= 0 > + ifTrue: [interpreterProxy methodReturnInteger: level] > + ifFalse: [interpreterProxy primitiveFail]! > - self primitive: 'primitiveSoundGetRecordLevel'. > - level := self cCode: 'snd_GetRecordLevel()'. > - ^level asPositiveIntegerObj > - ! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundGetRecordingSampleRate (in > category 'primitives') ----- > primitiveSoundGetRecordingSampleRate > "Return a float representing the actual sampling rate during > recording. Fail if not currently recording." > > + > | rate | > + > + rate := self snd_GetRecordingSampleRate. "fails if not recording" > + interpreterProxy failed ifFalse: > + [^interpreterProxy methodReturnFloat: rate]! > - > - self primitive: 'primitiveSoundGetRecordingSampleRate'. > - rate := self cCode: 'snd_GetRecordingSampleRate()'. "fail if not > recording" > - ^rate asFloatObj! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundGetVolume (in category > 'primitives') ----- > primitiveSoundGetVolume > + "Get the default output device's volume level as a left/right pair > of floats in the range 0-1." > + > + | left right leftOop rightOop results | > - "Get the sound input recording level." > - | left right results | > > > + left := 0.0. > + right := 0.0. > + self snd_Volume: (self addressOf: left put: [:v| left := v]) _: > (self addressOf: right put: [:v| right := v]). > + interpreterProxy failed ifTrue: > + [^self]. > + results := interpreterProxy instantiateClass: interpreterProxy > classArray indexableSize: 2. > + results ifNil: > + [^interpreterProxy primitiveFailFor: PrimErrNoMemory]. > + self remapOop: results in: > + [leftOop := interpreterProxy floatObjectOf: left. > + self remapOop: leftOop in: > + [rightOop := interpreterProxy floatObjectOf: > right]]. > + interpreterProxy > + storePointer: 0 ofObject: results withValue: leftOop; > + storePointer: 1 ofObject: results withValue: rightOop; > + methodReturnValue: results! > - self primitive: 'primitiveSoundGetVolume' > - parameters: #( ). > - left := 0. > - right := 0. > - self cCode: 'snd_Volume((double *) &left,(double *) &right)'. > - interpreterProxy pushRemappableOop: (right asOop: Float). > - interpreterProxy pushRemappableOop: (left asOop: Float). > - results := interpreterProxy instantiateClass: (interpreterProxy > classArray) indexableSize: 2. > - interpreterProxy storePointer: 0 ofObject: results withValue: > interpreterProxy popRemappableOop. > - interpreterProxy storePointer: 1 ofObject: results withValue: > interpreterProxy popRemappableOop. > - ^results! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundInsertSamples:from:leadTime: > (in category 'primitives') ----- > primitiveSoundInsertSamples: frameCount from: buf leadTime: leadTime > "Insert a buffer's worth of sound samples into the currently > playing > buffer. Used to make a sound start playing as quickly as possible. > The > new sound is mixed with the previously buffered sampled." > "Details: Unlike primitiveSoundPlaySamples, this primitive always > starts > with the first sample the given sample buffer. Its third argument > specifies the number of samples past the estimated sound output > buffer > position the inserted sound should start. If successful, it > returns the > number of samples inserted." > | framesPlayed | > self primitive: 'primitiveSoundInsertSamples' > + parameters: #(SmallInteger WordArray SmallInteger). > + frameCount <= (interpreterProxy slotSizeOf: buf cPtrAsOop) ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. > - parameters: #(SmallInteger WordArray SmallInteger ). > - interpreterProxy success: frameCount <= (interpreterProxy > slotSizeOf: buf cPtrAsOop). > > + framesPlayed := self snd_InsertSamplesFromLeadTime: frameCount _: > buf _: leadTime. > + framesPlayed >= 0 > + ifTrue: [interpreterProxy methodReturnInteger: > framesPlayed] > + ifFalse: [interpreterProxy primitiveFail]! > - interpreterProxy failed > - ifFalse: [framesPlayed := self cCode: > 'snd_InsertSamplesFromLeadTime(frameCount, (void *)buf, leadTime)'. > - interpreterProxy success: framesPlayed >= 0]. > - ^ framesPlayed asPositiveIntegerObj! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundPlaySamples:from:startingAt: > (in category 'primitives') ----- > primitiveSoundPlaySamples: frameCount from: buf startingAt: startIndex > "Output a buffer's worth of sound samples." > | framesPlayed | > self primitive: 'primitiveSoundPlaySamples' > + parameters: #(SmallInteger WordArray SmallInteger). > + (startIndex >= 1 and: [startIndex + frameCount - 1 <= > (interpreterProxy slotSizeOf: buf cPtrAsOop)]) ifTrue: > + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. > - parameters: #(SmallInteger WordArray SmallInteger ). > - interpreterProxy success: (startIndex >= 1 and: [startIndex + > frameCount - 1 <= (interpreterProxy slotSizeOf: buf cPtrAsOop)]). > > + framesPlayed := self snd_PlaySamplesFromAtLength: frameCount _: > buf _: startIndex - 1. > + framesPlayed >= 0 > + ifTrue: [interpreterProxy methodReturnInteger: > framesPlayed] > + ifFalse: [interpreterProxy primitiveFail]! > - interpreterProxy failed > - ifFalse: [framesPlayed := self cCode: > 'snd_PlaySamplesFromAtLength(frameCount, (void *)buf, startIndex - 1)'. > - interpreterProxy success: framesPlayed >= 0]. > - ^ framesPlayed asPositiveIntegerObj! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundPlaySilence (in category > 'primitives') ----- > primitiveSoundPlaySilence > "Output a buffer's worth of silence. Returns the number of sample > frames played." > > + > | framesPlayed | > + framesPlayed := self snd_PlaySilence. "-1 if sound output not > started" > + framesPlayed >= 0 > + ifTrue: [interpreterProxy methodReturnInteger: > framesPlayed] > + ifFalse: [interpreterProxy primitiveFail]! > - self primitive: 'primitiveSoundPlaySilence'. > - framesPlayed := self cCode: 'snd_PlaySilence()'. "-1 if sound > output not started" > - interpreterProxy success: framesPlayed >= 0. > - ^framesPlayed asPositiveIntegerObj! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundRecordSamplesInto:startingAt: > (in category 'primitives') ----- > primitiveSoundRecordSamplesInto: buf startingAt: startWordIndex > "Record a buffer's worth of 16-bit sound samples." > + | bufSizeInBytes samplesRecorded bufPtr byteOffset | > - | bufSizeInBytes samplesRecorded bufPtr byteOffset bufLen | > > self primitive: 'primitiveSoundRecordSamples' > + parameters: #(WordArray SmallInteger). > - parameters: #(WordArray SmallInteger ). > > + bufSizeInBytes := (interpreterProxy slotSizeOf: buf cPtrAsOop) * 4. > + byteOffset := (startWordIndex - 1) * 2. > - interpreterProxy failed ifFalse: > - [bufSizeInBytes := (interpreterProxy slotSizeOf: buf > cPtrAsOop) * 4. > - interpreterProxy success: (startWordIndex >= 1 and: > [startWordIndex - 1 * 2 < bufSizeInBytes])]. > > + (startWordIndex >= 1 and: [byteOffset < bufSizeInBytes]) ifFalse: > + [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. > - interpreterProxy failed ifFalse:[ > - byteOffset := (startWordIndex - 1) * 2. > - bufPtr := (self cCoerce: buf to: 'char*') + byteOffset. > - bufLen := bufSizeInBytes - byteOffset. > - samplesRecorded := self cCode: > 'snd_RecordSamplesIntoAtLength(bufPtr, 0, bufLen)' inSmalltalk:[bufPtr. > bufLen. 0]. > - ]. > > + bufPtr := (self cCoerce: buf to: #'char *') + byteOffset. > + samplesRecorded := self snd_RecordSamplesIntoAtLength: bufPtr _: 0 > _: bufSizeInBytes - byteOffset. > + interpreterProxy failed ifFalse: > + [^samplesRecorded asPositiveIntegerObj]! > - ^ samplesRecorded asPositiveIntegerObj! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundSetLeftVolume:rightVolume: (in > category 'primitives') ----- > primitiveSoundSetLeftVolume: aLeftVolume rightVolume: aRightVolume > "Set the sound input recording level." > > self primitive: 'primitiveSoundSetLeftVolume' > parameters: #(Float Float). > + self snd_SetVolume: aLeftVolume _: aRightVolume! > - interpreterProxy failed ifFalse: [self cCode: > 'snd_SetVolume(aLeftVolume,aRightVolume)']. > - ! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundSetRecordLevel: (in category > 'primitives') ----- > primitiveSoundSetRecordLevel: level > "Set the sound input recording level." > self primitive: 'primitiveSoundSetRecordLevel' > + parameters: #(SmallInteger). > + self snd_SetRecordLevel: level! > - parameters: #(SmallInteger ). > - interpreterProxy failed ifFalse: [self cCode: > 'snd_SetRecordLevel(level)']! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundStartBufferSize:rate:stereo: > (in category 'primitives') ----- > primitiveSoundStartBufferSize: bufFrames rate: samplesPerSec stereo: > stereoFlag > "Start the double-buffered sound output with the given buffer > size, sample rate, and stereo flag." > > self primitive: 'primitiveSoundStart' > parameters: #(SmallInteger SmallInteger Boolean). > + interpreterProxy success: (self snd_Start: bufFrames _: > samplesPerSec _: stereoFlag _: 0)! > - interpreterProxy success: (self cCode: 'snd_Start(bufFrames, > samplesPerSec, stereoFlag, 0)')! > > Item was changed: > ----- Method: > SoundPlugin>>primitiveSoundStartBufferSize:rate:stereo:semaIndex: (in > category 'primitives') ----- > primitiveSoundStartBufferSize: bufFrames rate: samplesPerSec stereo: > stereoFlag semaIndex: semaIndex > "Start the double-buffered sound output with the given buffer > size, sample rate, stereo flag, and semaphore index." > > self primitive: 'primitiveSoundStartWithSemaphore' > parameters: #(SmallInteger SmallInteger Boolean > SmallInteger). > + interpreterProxy success: (self snd_Start: bufFrames _: > samplesPerSec _: stereoFlag _: semaIndex)! > - interpreterProxy success: (self cCode: 'snd_Start(bufFrames, > samplesPerSec, stereoFlag, semaIndex)')! > > Item was changed: > ----- Method: > SoundPlugin>>primitiveSoundStartRecordingDesiredSampleRate:stereo:semaIndex: > (in category 'primitives') ----- > primitiveSoundStartRecordingDesiredSampleRate: desiredSamplesPerSec > stereo: stereoFlag semaIndex: semaIndex > "Start recording sound with the given parameters." > > self primitive: 'primitiveSoundStartRecording' > parameters: #(SmallInteger Boolean SmallInteger). > + self snd_StartRecording: desiredSamplesPerSec _: stereoFlag _: > semaIndex! > - self cCode: 'snd_StartRecording(desiredSamplesPerSec, stereoFlag, > semaIndex)'! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundStop (in category 'primitives') > ----- > primitiveSoundStop > "Stop double-buffered sound output." > + > + self snd_Stop! > - > - self primitive: 'primitiveSoundStop'. > - > - self cCode: 'snd_Stop()'. "leave rcvr on stack"! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundStopRecording (in category > 'primitives') ----- > primitiveSoundStopRecording > "Stop recording sound." > + > + self snd_StopRecording! > - > - self primitive: 'primitiveSoundStopRecording'. > - self cCode: 'snd_StopRecording()'. "leave rcvr on stack"! > > Item was changed: > ----- Method: SoundPlugin>>primitiveSoundSupportsAEC (in category > 'primitives') ----- > primitiveSoundSupportsAEC > + "Answer if the OS/hardware supports echo-cancellation." > + > - "Answer true if the OS/hardware supports echo-cancellation, and > false otherwise." > | result | > + result := self snd_SupportsAEC. > + interpreterProxy failed ifFalse: > + [interpreterProxy methodReturnBool: result ~= 0]! > - self primitive: 'primitiveSoundSupportsAEC'. > - interpreterProxy failed ifFalse: [ > - result := self cCode: 'snd_SupportsAEC()'. > - result == 0 ifTrue: [^interpreterProxy falseObject] > ifFalse: [^interpreterProxy trueObject] > - ]. > - ! > > Item was changed: > ----- Method: VMClass>>cCoerce:to: (in category 'memory access') ----- > cCoerce: value to: cTypeString > + "Type coercion. For translation a cast will be emitted. When > running in Smalltalk > - "Type coercion. For translation a cast will be emmitted. When > running in Smalltalk > answer a suitable wrapper for correct indexing." > > ^value > ifNil: [value] > ifNotNil: [value coerceTo: cTypeString sim: self]! > > Item was changed: > ----- Method: > VMPluginCodeGenerator>>shouldGenerateAsInterpreterProxySend: (in category > 'utilities') ----- > shouldGenerateAsInterpreterProxySend: aSendNode > "Answer if this send should be generated as interpreterProxy->foo > or its moral equivalent (*). > (*) since we now use function pointers declared in each external > plugin we only indirect through > interopreterProxy at plugin initialization. But we still have to > find the set of sends a plugin uses." > | selector | > (aSendNode receiver isVariable and: ['interpreterProxy' = > aSendNode receiver name]) ifFalse: [^false]. > selector := aSendNode selector. > "baseHeaderSize, minSmallInteger et al are #defined in each VM's > interp.h" > (VMBasicConstants mostBasicConstantSelectors includes: selector) > ifTrue: [^false]. > "Only include genuine InterpreterProxy methods, excluding things > not understood > + by InterpreterProxy and things in its initialize, private and > simulation protocols." > + ^(#(initialize private #'simulation only') includes: > (InterpreterProxy compiledMethodAt: selector ifAbsent: [^false]) protocol) > not! > - by InterpreterProxy and things in its initialize and private > protocols." > - ^(#(initialize private) includes: (InterpreterProxy > compiledMethodAt: selector ifAbsent: [^false]) protocol) not! > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Mon Aug 3 18:26:02 2020 From: noreply at github.com (Eliot Miranda) Date: Mon, 03 Aug 2020 11:26:02 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] f62317: MacOS builds: Get Objective-C files to compile wit... Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: f62317a5d3a5757ada4a62548b11c73a9b98155a https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/f62317a5d3a5757ada4a62548b11c73a9b98155a Author: Eliot Miranda Date: 2020-08-03 (Mon, 03 Aug 2020) Changed paths: M build.macos64ARMv8/common/Makefile.flags M build.macos64ARMv8/common/Makefile.vm M build.macos64x64/common/Makefile.flags M platforms/Cross/vm/sqAssert.h Log Message: ----------- MacOS builds: Get Objective-C files to compile with Xcode-beta on arm64. Eliminate a warning for error in sqHeapMap.c From noreply at github.com Mon Aug 3 18:41:34 2020 From: noreply at github.com (Eliot Miranda) Date: Mon, 03 Aug 2020 11:41:34 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] d57521: Add Ken Dickey's build.linux64ARMv8/HowToBuild (th... Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: d575211274c3e190f28fe986112092942ea36add https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/d575211274c3e190f28fe986112092942ea36add Author: Eliot Miranda Date: 2020-08-03 (Mon, 03 Aug 2020) Changed paths: A build.linux64ARMv8/HowToBuild Log Message: ----------- Add Ken Dickey's build.linux64ARMv8/HowToBuild (thnaks!!). [ci skip] From builds at travis-ci.org Mon Aug 3 18:48:25 2020 From: builds at travis-ci.org (Travis CI) Date: Mon, 03 Aug 2020 18:48:25 +0000 Subject: [Vm-dev] Errored: OpenSmalltalk/opensmalltalk-vm#2129 (Cog - f62317a) In-Reply-To: Message-ID: <5f285bf8723ae_13fc1e05c727c121475@travis-tasks-5d485b5999-wfrfh.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2129 Status: Errored Duration: 21 mins and 51 secs Commit: f62317a (Cog) Author: Eliot Miranda Message: MacOS builds: Get Objective-C files to compile with Xcode-beta on arm64. Eliminate a warning for error in sqHeapMap.c View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/3e9a53515b3f...f62317a5d3a5 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/714576675?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From no-reply at appveyor.com Mon Aug 3 21:08:51 2020 From: no-reply at appveyor.com (AppVeyor) Date: Mon, 03 Aug 2020 21:08:51 +0000 Subject: [Vm-dev] Build completed: opensmalltalk-vm 1.0.2127 Message-ID: <20200803210851.1.AD1131D78E8978EF@appveyor.com> An HTML attachment was scrubbed... URL: From noreply at github.com Mon Aug 3 23:15:59 2020 From: noreply at github.com (Eliot Miranda) Date: Mon, 03 Aug 2020 16:15:59 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 10c080: MacOSX SoundPlugin Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 10c08041c5c9d7f7ad4f099901970a0964b23880 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/10c08041c5c9d7f7ad4f099901970a0964b23880 Author: Eliot Miranda Date: 2020-08-03 (Mon, 03 Aug 2020) Changed paths: M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.h M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.m Log Message: ----------- MacOSX SoundPlugin Change how audio device change is notified (see https://stackoverflow.com/ questions/26070058/ how-to-get-notification-if-system-preferences-default-sound-changed) Clean up initialization to not install the runLoop more than once. Insertion/removal of headphones is now reliably detected. From builds at travis-ci.org Mon Aug 3 23:37:11 2020 From: builds at travis-ci.org (Travis CI) Date: Mon, 03 Aug 2020 23:37:11 +0000 Subject: [Vm-dev] Errored: OpenSmalltalk/opensmalltalk-vm#2130 (Cog - 10c0804) In-Reply-To: Message-ID: <5f289fa76b7aa_13fb46abd0e4426083e@travis-tasks-769c78766f-mcj4m.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2130 Status: Errored Duration: 20 mins and 37 secs Commit: 10c0804 (Cog) Author: Eliot Miranda Message: MacOSX SoundPlugin Change how audio device change is notified (see https://stackoverflow.com/ questions/26070058/ how-to-get-notification-if-system-preferences-default-sound-changed) Clean up initialization to not install the runLoop more than once. Insertion/removal of headphones is now reliably detected. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/d575211274c3...10c08041c5c9 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/714647079?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Tue Aug 4 01:19:40 2020 From: noreply at github.com (Eliot Miranda) Date: Mon, 03 Aug 2020 18:19:40 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 912398: Fix the core VM compilation issues on MacOSX ARMv8. Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 9123984a0edb758ed3681d087f4e7287ee5d124d https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/9123984a0edb758ed3681d087f4e7287ee5d124d Author: Eliot Miranda Date: 2020-08-03 (Mon, 03 Aug 2020) Changed paths: M build.macos64ARMv8/common/Makefile.flags M platforms/iOS/vm/OSX/sqSqueakOSXScreenAndWindow.m M platforms/unix/vm/include_ucontext.h Log Message: ----------- Fix the core VM compilation issues on MacOSX ARMv8. From builds at travis-ci.org Tue Aug 4 01:40:23 2020 From: builds at travis-ci.org (Travis CI) Date: Tue, 04 Aug 2020 01:40:23 +0000 Subject: [Vm-dev] Errored: OpenSmalltalk/opensmalltalk-vm#2131 (Cog - 9123984) In-Reply-To: Message-ID: <5f28bc8725ff8_13fb6b5ab645887753@travis-tasks-598b765b5d-jv8jr.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2131 Status: Errored Duration: 20 mins and 12 secs Commit: 9123984 (Cog) Author: Eliot Miranda Message: Fix the core VM compilation issues on MacOSX ARMv8. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/10c08041c5c9...9123984a0edb View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/714669465?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 4 16:14:59 2020 From: notifications at github.com (David Stes) Date: Tue, 04 Aug 2020 09:14:59 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 I tested compiling this branch 'sqUnixXdnd' on Solaris; the sqUnixXdnd code seems to compiles but how can I test please ? In order to compile I have to apply a small patch, but that is always the case. (see PR #496) It is an interesting topic, to hear and read about the history of the Unix VM and X11 support, which obviously is very much relevant to Solaris. However when you write "this does not show any regressions in an up to date Squeak image", what exactly did you test please ? Currently it seems I can drag a file into Squeak, and this creates as PluggableSystemWindow object. I don't seem to be able to drag anything out of Squeak. Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfKYlWAAoJEAwpOKXMq1MapMEH/iHRtguF8NLJsLMeECjDq9WD 6jmpOJLSx3yNti9uc4dONaHSLLPCNO3QhbdLEAx5V9oHHjU9DVteIX5EWPNPMz5M Rz0sO6uuKmdhptUzgIfxQCggm/C2hbVJZX4B72J6fGItpkyJTXUkl2tiwrKbFsZL J2YUErvZo9NEo9bzhihI+uYGhMTieGeyfJ7jYLL1H6TwEkaA1A93S8L66DjrtOEh Jg/nKkgcOAme9nSeaEjhOm/YazXdBeqej2e6uuD+8I4uVQ0BrdGivfDiMbKx8aOR K12CYMHNTFg96K5ti9P62CgY5cyLwor3YOFSogjDXJZppp0Uy2o6yy3UnO4VCT8= =CerU -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-668689833 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 4 18:13:37 2020 From: notifications at github.com (David Stes) Date: Tue, 04 Aug 2020 11:13:37 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Actually on further inspection, there seems to exist a variable if (getenv("SQUEAK_NOXDND")) useXdnd= 0; when set , this disables the dnd support. Indeed when export SQUEAK_NOXDND=1, the drag action of a file into Squeak, is not doing anything. But essentially I wonder (from the discussion) so far, what you are trying, to change with this dnd PR and how I could try to test it. David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfKaSSAAoJEAwpOKXMq1MaC2QH/jIVUBRVOBBVqdF4tdpTxHUn /H/quqS2MeD/MOTuV0UzWod41hNk9at//WiMM13mj4LAaWJyVcUFivLo4/68HUTe IH3O3rC6RjztymoxD/kF6yT4nq7/Ay56706g1d/B9VPnl6Xk8z4bYuF4M1QvzG08 EwylFyc8tvxJiPs6TVmg0Hs/lx0Y2KPpdqnvlC3IC5U2dKI411rc4T4iWiQZix/U IBbu+75gzTnOJlphNTPlRcesb6nEmqo57zfomBjW/GbUk28URtVoSnVmZZmvEUA2 4LZC2DpNdnZKA4dfdeQbBrvP7ndcHmSU6XjxAYTDWcKaCczj9/um4ChUbHQXnSs= =y80j -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-668748316 -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Wed Aug 5 18:36:09 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 5 Aug 2020 18:36:09 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2786.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2786.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2786 Author: eem Time: 5 August 2020, 11:36:00.348057 am UUID: 4a2487b6-5a6f-4baa-bd3a-534337e78564 Ancestors: VMMaker.oscog-eem.2785 SoundPlugin: Fix a regression in primitiveSoundPlaySamples:from:startingAt: from VMMaker.oscog-eem.2785. =============== Diff against VMMaker.oscog-eem.2785 =============== Item was changed: ----- Method: SoundPlugin>>primitiveSoundInsertSamples:from:leadTime: (in category 'primitives') ----- primitiveSoundInsertSamples: frameCount from: buf leadTime: leadTime "Insert a buffer's worth of sound samples into the currently playing buffer. Used to make a sound start playing as quickly as possible. The new sound is mixed with the previously buffered sampled." "Details: Unlike primitiveSoundPlaySamples, this primitive always starts with the first sample the given sample buffer. Its third argument specifies the number of samples past the estimated sound output buffer position the inserted sound should start. If successful, it returns the number of samples inserted." | framesPlayed | self primitive: 'primitiveSoundInsertSamples' parameters: #(SmallInteger WordArray SmallInteger). + (self cCoerce: frameCount to: #usqInt) > (interpreterProxy slotSizeOf: buf cPtrAsOop) ifTrue: - frameCount <= (interpreterProxy slotSizeOf: buf cPtrAsOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. framesPlayed := self snd_InsertSamplesFromLeadTime: frameCount _: buf _: leadTime. framesPlayed >= 0 ifTrue: [interpreterProxy methodReturnInteger: framesPlayed] ifFalse: [interpreterProxy primitiveFail]! Item was changed: ----- Method: SoundPlugin>>primitiveSoundPlaySamples:from:startingAt: (in category 'primitives') ----- primitiveSoundPlaySamples: frameCount from: buf startingAt: startIndex "Output a buffer's worth of sound samples." | framesPlayed | self primitive: 'primitiveSoundPlaySamples' parameters: #(SmallInteger WordArray SmallInteger). + (startIndex >= 1 and: [startIndex + frameCount - 1 <= (interpreterProxy slotSizeOf: buf cPtrAsOop)]) ifFalse: - (startIndex >= 1 and: [startIndex + frameCount - 1 <= (interpreterProxy slotSizeOf: buf cPtrAsOop)]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. framesPlayed := self snd_PlaySamplesFromAtLength: frameCount _: buf _: startIndex - 1. framesPlayed >= 0 ifTrue: [interpreterProxy methodReturnInteger: framesPlayed] ifFalse: [interpreterProxy primitiveFail]! From noreply at github.com Wed Aug 5 18:39:24 2020 From: noreply at github.com (Eliot Miranda) Date: Wed, 05 Aug 2020 11:39:24 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] ccd863: CogVM source as per VMMaker.oscog-eem.2786 Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: ccd863eeda86fbafebd8c14030d1f1054d5a22a4 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ccd863eeda86fbafebd8c14030d1f1054d5a22a4 Author: Eliot Miranda Date: 2020-08-05 (Wed, 05 Aug 2020) Changed paths: M src/plugins/SoundPlugin/SoundPlugin.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.2786 SoundPlugin: Fix a regression in primitiveSoundPlaySamples:from:startingAt: from VMMaker.oscog-eem.2785. From builds at travis-ci.org Wed Aug 5 19:01:45 2020 From: builds at travis-ci.org (Travis CI) Date: Wed, 05 Aug 2020 19:01:45 +0000 Subject: [Vm-dev] Failed: OpenSmalltalk/opensmalltalk-vm#2132 (Cog - ccd863e) In-Reply-To: Message-ID: <5f2b02197bd60_13fb0379a5a482431d9@travis-tasks-6d564c56f5-7krf6.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2132 Status: Failed Duration: 21 mins and 48 secs Commit: ccd863e (Cog) Author: Eliot Miranda Message: CogVM source as per VMMaker.oscog-eem.2786 SoundPlugin: Fix a regression in primitiveSoundPlaySamples:from:startingAt: from VMMaker.oscog-eem.2785. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/9123984a0edb...ccd863eeda86 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/715255876?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Sun Aug 9 22:32:25 2020 From: noreply at github.com (Eliot Miranda) Date: Sun, 09 Aug 2020 15:32:25 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 5da52e: Extend include_ucontext.h and use it for reportSta... Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 5da52efd0335ab475c991969e9daf08e7267a619 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/5da52efd0335ab475c991969e9daf08e7267a619 Author: Eliot Miranda Date: 2020-08-09 (Sun, 09 Aug 2020) Changed paths: M platforms/Cross/plugins/FloatMathPlugin/ieee754names.h M platforms/Mac OS/vm/sqMacMain.c M platforms/iOS/vm/Common/Classes/sqSqueakMainApp.m M platforms/unix/vm/include_ucontext.h M platforms/unix/vm/sqUnixMain.c Log Message: ----------- Extend include_ucontext.h and use it for reportStackState on unix platforms. From noreply at github.com Sun Aug 9 22:37:21 2020 From: noreply at github.com (Eliot Miranda) Date: Sun, 09 Aug 2020 15:37:21 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] d253c9: Nuking some doubled semicolons [ci skip] Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: d253c9ef5cd7dc44d603aa7ebd6464374144d29e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/d253c9ef5cd7dc44d603aa7ebd6464374144d29e Author: Eliot Miranda Date: 2020-08-09 (Sun, 09 Aug 2020) Changed paths: M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.m Log Message: ----------- Nuking some doubled semicolons [ci skip] Commit: 3bc7f3e65bb484d236c0d9f0f2b63b60a7021bb9 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/3bc7f3e65bb484d236c0d9f0f2b63b60a7021bb9 Author: Eliot Miranda Date: 2020-08-09 (Sun, 09 Aug 2020) Changed paths: M platforms/Cross/plugins/FloatMathPlugin/ieee754names.h M platforms/Mac OS/vm/sqMacMain.c M platforms/iOS/vm/Common/Classes/sqSqueakMainApp.m M platforms/unix/vm/include_ucontext.h M platforms/unix/vm/sqUnixMain.c Log Message: ----------- Merge branch 'Cog' of https://github.com/OpenSmalltalk/opensmalltalk-vm into Cog Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/5da52efd0335...3bc7f3e65bb4 From builds at travis-ci.org Sun Aug 9 22:52:31 2020 From: builds at travis-ci.org (Travis CI) Date: Sun, 09 Aug 2020 22:52:31 +0000 Subject: [Vm-dev] Still Failing: OpenSmalltalk/opensmalltalk-vm#2133 (Cog - 5da52ef) In-Reply-To: Message-ID: <5f307e2f33f6e_13feaeeb9ec2c218616@travis-tasks-78c6678599-b89xf.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2133 Status: Still Failing Duration: 26 mins and 39 secs Commit: 5da52ef (Cog) Author: Eliot Miranda Message: Extend include_ucontext.h and use it for reportStackState on unix platforms. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/ccd863eeda86...5da52efd0335 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/716391258?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Sun Aug 9 23:01:20 2020 From: noreply at github.com (Eliot Miranda) Date: Sun, 09 Aug 2020 16:01:20 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 29a380: Get the 64-bit Stack Spur VM to compile on Apple S... Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 29a3800010c00e3f9177b241ab49fdffa3a0c6dc https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/29a3800010c00e3f9177b241ab49fdffa3a0c6dc Author: Eliot Miranda Date: 2020-08-09 (Sun, 09 Aug 2020) Changed paths: M platforms/Cross/plugins/IA32ABI/arm32abicc.c M platforms/Cross/plugins/IA32ABI/arm64abicc.c M platforms/Cross/plugins/IA32ABI/dabusiness.h M platforms/Cross/plugins/IA32ABI/dabusinessARM.h M platforms/Cross/plugins/IA32ABI/dabusinessARM32.h M platforms/Cross/plugins/IA32ABI/dabusinessARM64.h M platforms/Cross/plugins/IA32ABI/dabusinessPostLogic.h M platforms/Cross/plugins/IA32ABI/dabusinessppc.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicDouble.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicFloat.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicInteger.h M platforms/Cross/plugins/IA32ABI/ia32abicc.c M platforms/Cross/plugins/IA32ABI/ppc32abicc.c M platforms/Cross/plugins/IA32ABI/x64sysvabicc.c M platforms/Cross/plugins/IA32ABI/x64win64abicc.c Log Message: ----------- Get the 64-bit Stack Spur VM to compile on Apple Silicon. This is a matter of eliminating any implciit declarations. Hence observe that getpagesize is deprecated in modern POSIX_C regimes, where sysconf(_SC_PAGESIZE) is to be used. Commit: 8287971ddf53bb17d30a43dff6a7321c7e25823d https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/8287971ddf53bb17d30a43dff6a7321c7e25823d Author: Eliot Miranda Date: 2020-08-09 (Sun, 09 Aug 2020) Changed paths: M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.m Log Message: ----------- Merge branch 'Cog' of https://github.com/OpenSmalltalk/opensmalltalk-vm into Cog Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/3bc7f3e65bb4...8287971ddf53 From builds at travis-ci.org Sun Aug 9 23:08:46 2020 From: builds at travis-ci.org (Travis CI) Date: Sun, 09 Aug 2020 23:08:46 +0000 Subject: [Vm-dev] Still Failing: OpenSmalltalk/opensmalltalk-vm#2134 (Cog - 3bc7f3e) In-Reply-To: Message-ID: <5f3081fe1a73c_13feaeeb9f94c233272@travis-tasks-78c6678599-b89xf.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2134 Status: Still Failing Duration: 30 mins and 48 secs Commit: 3bc7f3e (Cog) Author: Eliot Miranda Message: Merge branch 'Cog' of https://github.com/OpenSmalltalk/opensmalltalk-vm into Cog View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/5da52efd0335...3bc7f3e65bb4 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/716392068?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From builds at travis-ci.org Sun Aug 9 23:25:42 2020 From: builds at travis-ci.org (Travis CI) Date: Sun, 09 Aug 2020 23:25:42 +0000 Subject: [Vm-dev] Still Failing: OpenSmalltalk/opensmalltalk-vm#2135 (Cog - 8287971) In-Reply-To: Message-ID: <5f3085f5b07a2_13feaeeb9f94c24829@travis-tasks-78c6678599-b89xf.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2135 Status: Still Failing Duration: 23 mins and 47 secs Commit: 8287971 (Cog) Author: Eliot Miranda Message: Merge branch 'Cog' of https://github.com/OpenSmalltalk/opensmalltalk-vm into Cog View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/3bc7f3e65bb4...8287971ddf53 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/716395277?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From no-reply at appveyor.com Mon Aug 10 06:30:18 2020 From: no-reply at appveyor.com (AppVeyor) Date: Mon, 10 Aug 2020 06:30:18 +0000 Subject: [Vm-dev] Build failed: opensmalltalk-vm 1.0.2133 Message-ID: <20200810063018.1.5B1CC6169E6AF1C2@appveyor.com> An HTML attachment was scrubbed... URL: From noreply at github.com Mon Aug 10 20:52:43 2020 From: noreply at github.com (Eliot Miranda) Date: Mon, 10 Aug 2020 13:52:43 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 396bcf: Misc platform changes. Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 396bcfa1b8498eda318ffab7374abc81ba1f6c13 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/396bcfa1b8498eda318ffab7374abc81ba1f6c13 Author: Eliot Miranda Date: 2020-08-10 (Mon, 10 Aug 2020) Changed paths: M build.macos64ARMv8/squeak.cog.spur/plugins.ext M platforms/iOS/vm/OSX/sqSqueakOSXApplication+attributes.m M platforms/iOS/vm/iPhone/Classes/sqSqueakIPhoneApplication+attributes.m M platforms/unix/vm/include_ucontext.h Log Message: ----------- Misc platform changes. Update include_ucontext.h with fp & sp on ARMv8. Side-step CameraPlugin build failure on MacOS 11.x SDK due to deprecated bhvr. Get Mac VMs to answer correcvt processor on ARMv8 (aarch64). From builds at travis-ci.org Mon Aug 10 20:59:13 2020 From: builds at travis-ci.org (Travis CI) Date: Mon, 10 Aug 2020 20:59:13 +0000 Subject: [Vm-dev] Errored: OpenSmalltalk/opensmalltalk-vm#2136 (Cog - 396bcfa) In-Reply-To: Message-ID: <5f31b520d1270_13fafd00436ec1056f1@travis-tasks-66dd8bd96d-529mz.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2136 Status: Errored Duration: 5 mins and 56 secs Commit: 396bcfa (Cog) Author: Eliot Miranda Message: Misc platform changes. Update include_ucontext.h with fp & sp on ARMv8. Side-step CameraPlugin build failure on MacOS 11.x SDK due to deprecated bhvr. Get Mac VMs to answer correcvt processor on ARMv8 (aarch64). View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/8287971ddf53...396bcfa1b849 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/716703903?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Mon Aug 10 21:22:47 2020 From: noreply at github.com (Eliot Miranda) Date: Mon, 10 Aug 2020 14:22:47 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] f31fe3: Avoid deprecation warnings for Gestalt on Mac OS, ... Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: f31fe35c3a18c2e4ab3abf3ef2332e8be60e27e8 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/f31fe35c3a18c2e4ab3abf3ef2332e8be60e27e8 Author: Eliot Miranda Date: 2020-08-10 (Mon, 10 Aug 2020) Changed paths: M build.macos64ARMv8/makeallinstall M build.macos64ARMv8/makeproduct M platforms/iOS/vm/OSX/sqSqueakOSXApplication+attributes.m Log Message: ----------- Avoid deprecation warnings for Gestalt on Mac OS, and lack of definition of gestaltArm on older SDKs. From builds at travis-ci.org Mon Aug 10 21:50:14 2020 From: builds at travis-ci.org (Travis CI) Date: Mon, 10 Aug 2020 21:50:14 +0000 Subject: [Vm-dev] Failed: OpenSmalltalk/opensmalltalk-vm#2137 (Cog - f31fe35) In-Reply-To: Message-ID: <5f31c11486d5a_13fafd8a5120814087@travis-tasks-66dd8bd96d-529mz.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2137 Status: Failed Duration: 21 mins and 54 secs Commit: f31fe35 (Cog) Author: Eliot Miranda Message: Avoid deprecation warnings for Gestalt on Mac OS, and lack of definition of gestaltArm on older SDKs. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/396bcfa1b849...f31fe35c3a18 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/716711320?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Mon Aug 10 21:57:28 2020 From: noreply at github.com (Eliot Miranda) Date: Mon, 10 Aug 2020 14:57:28 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 2a7b21: Fix a typo [ci skip] Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 2a7b21ed75701388b1689c48636d09777ef582e2 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2a7b21ed75701388b1689c48636d09777ef582e2 Author: Eliot Miranda Date: 2020-08-10 (Mon, 10 Aug 2020) Changed paths: M build.macos32x86/common/Makefile.vm M build.macos64ARMv8/common/Makefile.vm M build.macos64x64/common/Makefile.vm Log Message: ----------- Fix a typo [ci skip] From no-reply at appveyor.com Mon Aug 10 23:32:07 2020 From: no-reply at appveyor.com (AppVeyor) Date: Mon, 10 Aug 2020 23:32:07 +0000 Subject: [Vm-dev] Build completed: opensmalltalk-vm 1.0.2134 Message-ID: <20200810233207.1.84E20D7837D8CD4D@appveyor.com> An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Wed Aug 12 14:47:05 2020 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Wed, 12 Aug 2020 07:47:05 -0700 Subject: [Vm-dev] Win64 Builds broken, slow build times? In-Reply-To: References: Message-ID: Hi Tom, Hi Marcel, I also see that the mingw32/Cygwin/clang build is broken but the MSVC/Clang build is not. If you use gdb to find out where the mingw32/Cygwin/clang breaks you will see that it is in the zeroing of the stack zone memory after the initial alloca of the stack zone. The stack pointer gets set to a lower value by the alloca, as expected, but the stack memory is not committed so when the memset starts writing to the memory pointed to by the stack pointer it segfaults. I initially had the same problem with the MSVC/Clang build, but at a different point, the JIT. The JIT stack allocates the memory it uses for generating abstract instructions, etc, when generating machine code. It can stack allocate over a megabyte. To fix the crash I used the linker’s /STACK=size,committed flag to give the executable a 2mb fully committed stack, and this fixed the crashes. I am using the MSVC/Clang build for Terf and we have had no problems with the core VM since. However, in looking at SoundPlugin issues I did try the mingw32/Cygwin/clang build last week and saw the stack zone alloca crash that I expect is the cause of the breakage you observe. I did have time to add a —stack size,committed flag to attempt to give the executable a 2mb fully committed stack, but this did not work and did not fix the crash, which remains in the same place. I conclude that the way I tried to add the —stack size,committed flag is incorrect, although the linked did not produce any error messages. I wish I had time to look at this but I don’t. If anyone does have time, then my suggestion is to do a MSVC/Clang build alongside the mingw32/Cygwin/clang one, and find out how to introspect the executable to list its stack allocation parameters. I know that MSVC’s editbin can be used to set these parameters but don’t know of a program to list them. One obvious test is to use editbin to set the stack allocation parameters of the mingw32/Cygwin/clang build. If my hypothesis is correct then it should produce a vm that starts up, and then the attempt to fix is simple, find out how to get the mingw32/Cygwin/clang linker to set correctly the stack allocation parameters. HTH > On May 18, 2020, at 11:40 PM, Marcel Taeumel wrote: >  > Hi Eliot, hi Tom, > > I reported this issue about a week ago: > https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498 > > Bintray version squeak.cog.spur_win64x64_202005170205 is still broken. Segfaults on startup. > > Best, > Marcel >> Am 19.05.2020 01:02:06 schrieb Eliot Miranda : >> >> >> Hi Tom, >> >> >> > On May 18, 2020, at 1:44 PM, Tom Beckmann wrote: >> > >> >  >> > Hi everyone, >> > >> > I just tried building build.win64x64/squeak.cog.spur on the Cog branch but got a segfault on startup. I then tentatively went back 10 commits (HEAD~10) and it worked again. This is the output I received in gdb: >> > >> > Thread 1 received signal SIGSEGV, Segmentation fault. >> > 0x00000000004016f3 in interpret () at ../../spur64src/vm/gcc3x-cointerp.c:2809 >> > 2809 memset(theStackMemory, 0, stackPagesBytes); >> > (gdb) bt >> > #0 0x00000000004016f3 in interpret () at ../../spur64src/vm/gcc3x-cointerp.c:2809 >> > #1 0x000000000052c34c in sqMain (argc=2, argv=0x1dd53a0) at ../../platforms/win32/vm/sqWin32Main.c:1709 >> > #2 0x000000000052c7f2 in WinMain (hInst=0x400000, hPrevInstance=0x0, lpCmdLine=0xfc437c "../../../Squeak6.0alpha-19582-64bit-202003021730-Windows/Squeak6.0alpha-19582-64bit.image", nCmdShow=10) at ../../platforms/win32/vm/sqWin32Main.c:1802 >> > #3 0x00000000004013c7 in __tmainCRTStartup () at /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:339 >> > #4 0x00000000004014cb in WinMainCRTStartup () at /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:195 >> > >> > The main reason I'm writing, however, is that I only haven't done a bisect yet because building the VM appears unusually slow, when compared to building on Linux, as in, orders of magnitude slower. I believe I have the same setup as we do on appveyor on windows using cygwin64. Incremental builds seem to recompile a lot of files and it appears there are race conditions when building with multiple threads (-j8). Are these known limitations of the Windows build or am I potentially just having the wrong setup? >> >> I hope it is simply wrong setup. I have been making these commits in recent weeks in the context of getting 64-bit Terf working. Terf is 3D ICC’s Croquet-derived business communications tool which was formerly known as Teleplace and Qwaq forums and was the context in which OpenSmalltalk-vm was conceived. >> >> I am building 64-bits using Clang 10 and MSVC and I assure you this works. See HowToBuild for how to build using this configuration. >> >> Your configuration may be obsolete or it may be valid, and if valid we should fix it. Can you list exactly what versions of software (Cygwin or mingw, gcc, clang) you’re using your build? >> >> >> > Thank you for any pointers! >> > Tom >> >> Eliot >> _,,,^..^,,,_ (phone) Eliot _,,,^..^,,,_ (phone) -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicolas.cellier.aka.nice at gmail.com Wed Aug 12 15:06:22 2020 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Wed, 12 Aug 2020 17:06:22 +0200 Subject: [Vm-dev] Win64 Builds broken, slow build times? In-Reply-To: References: Message-ID: Hi Eliot, also, did you see my comment https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498#issuecomment-647189330 removing -mno-stack-arg-probe option from the makefile solves the cygwin build. See also https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/920248dc54ecbcadd9121058360081665d3c7460#r40066039 Maybe we can just make the option msvc-build specific as a temporary workaround... Le mer. 12 août 2020 à 16:47, Eliot Miranda a écrit : > > Hi Tom, Hi Marcel, > > I also see that the mingw32/Cygwin/clang build is broken but the > MSVC/Clang build is not. > > If you use gdb to find out where the mingw32/Cygwin/clang breaks you will > see that it is in the zeroing of the stack zone memory after the initial > alloca of the stack zone. The stack pointer gets set to a lower value by > the alloca, as expected, but the stack memory is not committed so when the > memset starts writing to the memory pointed to by the stack pointer it > segfaults. > > I initially had the same problem with the MSVC/Clang build, but at a > different point, the JIT. The JIT stack allocates the memory it uses for > generating abstract instructions, etc, when generating machine code. It > can stack allocate over a megabyte. To fix the crash I used the linker’s > /STACK=size,committed flag to give the executable a 2mb fully committed > stack, and this fixed the crashes. > > I am using the MSVC/Clang build for Terf and we have had no problems with > the core VM since. However, in looking at SoundPlugin issues I did try the > mingw32/Cygwin/clang build last week and saw the stack zone alloca crash > that I expect is the cause of the breakage you observe. I did have time to > add a —stack size,committed flag to attempt to give the executable a 2mb > fully committed stack, but this did not work and did not fix the crash, > which remains in the same place. I conclude that the way I tried to add > the —stack size,committed flag is incorrect, although the linked did not > produce any error messages. > > I wish I had time to look at this but I don’t. If anyone does have time, > then my suggestion is to do a MSVC/Clang build alongside the > mingw32/Cygwin/clang one, and find out how to introspect the executable to > list its stack allocation parameters. I know that MSVC’s editbin can be > used to set these parameters but don’t know of a program to list them. One > obvious test is to use editbin to set the stack allocation parameters of > the mingw32/Cygwin/clang build. If my hypothesis is correct then it should > produce a vm that starts up, and then the attempt to fix is simple, find > out how to get the mingw32/Cygwin/clang linker to set correctly the stack > allocation parameters. > > HTH > > On May 18, 2020, at 11:40 PM, Marcel Taeumel > wrote: > >  > Hi Eliot, hi Tom, > > I reported this issue about a week ago: > https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498 > > Bintray version squeak.cog.spur_win64x64_202005170205 is still broken. > Segfaults on startup. > > Best, > Marcel > > Am 19.05.2020 01:02:06 schrieb Eliot Miranda : > > Hi Tom, > > > > On May 18, 2020, at 1:44 PM, Tom Beckmann wrote: > > > >  > > Hi everyone, > > > > I just tried building build.win64x64/squeak.cog.spur on the Cog branch > but got a segfault on startup. I then tentatively went back 10 commits > (HEAD~10) and it worked again. This is the output I received in gdb: > > > > Thread 1 received signal SIGSEGV, Segmentation fault. > > 0x00000000004016f3 in interpret () at > ../../spur64src/vm/gcc3x-cointerp.c:2809 > > 2809 memset(theStackMemory, 0, stackPagesBytes); > > (gdb) bt > > #0 0x00000000004016f3 in interpret () at > ../../spur64src/vm/gcc3x-cointerp.c:2809 > > #1 0x000000000052c34c in sqMain (argc=2, argv=0x1dd53a0) at > ../../platforms/win32/vm/sqWin32Main.c:1709 > > #2 0x000000000052c7f2 in WinMain (hInst=0x400000, hPrevInstance=0x0, > lpCmdLine=0xfc437c > "../../../Squeak6.0alpha-19582-64bit-202003021730-Windows/Squeak6.0alpha-19582-64bit.image", > nCmdShow=10) at ../../platforms/win32/vm/sqWin32Main.c:1802 > > #3 0x00000000004013c7 in __tmainCRTStartup () at > /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:339 > > #4 0x00000000004014cb in WinMainCRTStartup () at > /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:195 > > > > The main reason I'm writing, however, is that I only haven't done a > bisect yet because building the VM appears unusually slow, when compared to > building on Linux, as in, orders of magnitude slower. I believe I have the > same setup as we do on appveyor on windows using cygwin64. Incremental > builds seem to recompile a lot of files and it appears there are race > conditions when building with multiple threads (-j8). Are these known > limitations of the Windows build or am I potentially just having the wrong > setup? > > I hope it is simply wrong setup. I have been making these commits in > recent weeks in the context of getting 64-bit Terf working. Terf is 3D > ICC’s Croquet-derived business communications tool which was formerly known > as Teleplace and Qwaq forums and was the context in which OpenSmalltalk-vm > was conceived. > > I am building 64-bits using Clang 10 and MSVC and I assure you this works. > See HowToBuild for how to build using this configuration. > > Your configuration may be obsolete or it may be valid, and if valid we > should fix it. Can you list exactly what versions of software (Cygwin or > mingw, gcc, clang) you’re using your build? > > > > Thank you for any pointers! > > Tom > > Eliot > _,,,^..^,,,_ (phone) > > > > Eliot > _,,,^..^,,,_ (phone) > -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Wed Aug 12 15:37:29 2020 From: notifications at github.com (Nicolas Cellier) Date: Wed, 12 Aug 2020 08:37:29 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] Latest commit segfaults win64x64.squeak.cog.spur (#498) In-Reply-To: References: Message-ID: This might be relevant material about stack handling in windows NT: https://stackoverflow.com/questions/8400118/what-is-the-purpose-of-the-chkstk-function https://archive.is/J01oT https://docs.microsoft.com/en-us/windows/win32/devnotes/-win32-chkstk https://bugs.llvm.org/show_bug.cgi?id=36221 https://bugs.llvm.org/show_bug.cgi?id=21896 ... -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498#issuecomment-672949156 -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicolas.cellier.aka.nice at gmail.com Wed Aug 12 15:42:02 2020 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Wed, 12 Aug 2020 17:42:02 +0200 Subject: [Vm-dev] Win64 Builds broken, slow build times? In-Reply-To: References: Message-ID: >From https://archive.is/J01oT, my understanding is that if we remove stack-probe, then we are not anymore protected from a stack overflow when trying to allocate more than a page size on stack... Does it help? Le mer. 12 août 2020 à 17:06, Nicolas Cellier < nicolas.cellier.aka.nice at gmail.com> a écrit : > Hi Eliot, > also, did you see my comment > https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498#issuecomment-647189330 > removing -mno-stack-arg-probe option from the makefile solves the cygwin > build. > See also > https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/920248dc54ecbcadd9121058360081665d3c7460#r40066039 > Maybe we can just make the option msvc-build specific as a temporary > workaround... > > Le mer. 12 août 2020 à 16:47, Eliot Miranda a > écrit : > >> >> Hi Tom, Hi Marcel, >> >> I also see that the mingw32/Cygwin/clang build is broken but the >> MSVC/Clang build is not. >> >> If you use gdb to find out where the mingw32/Cygwin/clang breaks you will >> see that it is in the zeroing of the stack zone memory after the initial >> alloca of the stack zone. The stack pointer gets set to a lower value by >> the alloca, as expected, but the stack memory is not committed so when the >> memset starts writing to the memory pointed to by the stack pointer it >> segfaults. >> >> I initially had the same problem with the MSVC/Clang build, but at a >> different point, the JIT. The JIT stack allocates the memory it uses for >> generating abstract instructions, etc, when generating machine code. It >> can stack allocate over a megabyte. To fix the crash I used the linker’s >> /STACK=size,committed flag to give the executable a 2mb fully committed >> stack, and this fixed the crashes. >> >> I am using the MSVC/Clang build for Terf and we have had no problems with >> the core VM since. However, in looking at SoundPlugin issues I did try the >> mingw32/Cygwin/clang build last week and saw the stack zone alloca crash >> that I expect is the cause of the breakage you observe. I did have time to >> add a —stack size,committed flag to attempt to give the executable a 2mb >> fully committed stack, but this did not work and did not fix the crash, >> which remains in the same place. I conclude that the way I tried to add >> the —stack size,committed flag is incorrect, although the linked did not >> produce any error messages. >> >> I wish I had time to look at this but I don’t. If anyone does have time, >> then my suggestion is to do a MSVC/Clang build alongside the >> mingw32/Cygwin/clang one, and find out how to introspect the executable to >> list its stack allocation parameters. I know that MSVC’s editbin can be >> used to set these parameters but don’t know of a program to list them. One >> obvious test is to use editbin to set the stack allocation parameters of >> the mingw32/Cygwin/clang build. If my hypothesis is correct then it should >> produce a vm that starts up, and then the attempt to fix is simple, find >> out how to get the mingw32/Cygwin/clang linker to set correctly the stack >> allocation parameters. >> >> HTH >> >> On May 18, 2020, at 11:40 PM, Marcel Taeumel >> wrote: >> >>  >> Hi Eliot, hi Tom, >> >> I reported this issue about a week ago: >> https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498 >> >> Bintray version squeak.cog.spur_win64x64_202005170205 is still broken. >> Segfaults on startup. >> >> Best, >> Marcel >> >> Am 19.05.2020 01:02:06 schrieb Eliot Miranda : >> >> Hi Tom, >> >> >> > On May 18, 2020, at 1:44 PM, Tom Beckmann wrote: >> > >> >  >> > Hi everyone, >> > >> > I just tried building build.win64x64/squeak.cog.spur on the Cog branch >> but got a segfault on startup. I then tentatively went back 10 commits >> (HEAD~10) and it worked again. This is the output I received in gdb: >> > >> > Thread 1 received signal SIGSEGV, Segmentation fault. >> > 0x00000000004016f3 in interpret () at >> ../../spur64src/vm/gcc3x-cointerp.c:2809 >> > 2809 memset(theStackMemory, 0, stackPagesBytes); >> > (gdb) bt >> > #0 0x00000000004016f3 in interpret () at >> ../../spur64src/vm/gcc3x-cointerp.c:2809 >> > #1 0x000000000052c34c in sqMain (argc=2, argv=0x1dd53a0) at >> ../../platforms/win32/vm/sqWin32Main.c:1709 >> > #2 0x000000000052c7f2 in WinMain (hInst=0x400000, hPrevInstance=0x0, >> lpCmdLine=0xfc437c >> "../../../Squeak6.0alpha-19582-64bit-202003021730-Windows/Squeak6.0alpha-19582-64bit.image", >> nCmdShow=10) at ../../platforms/win32/vm/sqWin32Main.c:1802 >> > #3 0x00000000004013c7 in __tmainCRTStartup () at >> /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:339 >> > #4 0x00000000004014cb in WinMainCRTStartup () at >> /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:195 >> > >> > The main reason I'm writing, however, is that I only haven't done a >> bisect yet because building the VM appears unusually slow, when compared to >> building on Linux, as in, orders of magnitude slower. I believe I have the >> same setup as we do on appveyor on windows using cygwin64. Incremental >> builds seem to recompile a lot of files and it appears there are race >> conditions when building with multiple threads (-j8). Are these known >> limitations of the Windows build or am I potentially just having the wrong >> setup? >> >> I hope it is simply wrong setup. I have been making these commits in >> recent weeks in the context of getting 64-bit Terf working. Terf is 3D >> ICC’s Croquet-derived business communications tool which was formerly known >> as Teleplace and Qwaq forums and was the context in which OpenSmalltalk-vm >> was conceived. >> >> I am building 64-bits using Clang 10 and MSVC and I assure you this >> works. See HowToBuild for how to build using this configuration. >> >> Your configuration may be obsolete or it may be valid, and if valid we >> should fix it. Can you list exactly what versions of software (Cygwin or >> mingw, gcc, clang) you’re using your build? >> >> >> > Thank you for any pointers! >> > Tom >> >> Eliot >> _,,,^..^,,,_ (phone) >> >> >> >> Eliot >> _,,,^..^,,,_ (phone) >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicolas.cellier.aka.nice at gmail.com Wed Aug 12 16:32:52 2020 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Wed, 12 Aug 2020 18:32:52 +0200 Subject: [Vm-dev] Win64 Builds broken, slow build times? In-Reply-To: References: Message-ID: So the question is why is -mno-stack-arg-probe required, optimization apart? If for no other purpose than optimization, we shall better remove this form cygwin build, until we find out how to reserve (committed) stack space... Le mer. 12 août 2020 à 17:42, Nicolas Cellier < nicolas.cellier.aka.nice at gmail.com> a écrit : > From https://archive.is/J01oT, my understanding is that if we remove > stack-probe, then we are not anymore protected from a stack overflow when > trying to allocate more than a page size on stack... > Does it help? > > Le mer. 12 août 2020 à 17:06, Nicolas Cellier < > nicolas.cellier.aka.nice at gmail.com> a écrit : > >> Hi Eliot, >> also, did you see my comment >> https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498#issuecomment-647189330 >> removing -mno-stack-arg-probe option from the makefile solves the cygwin >> build. >> See also >> https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/920248dc54ecbcadd9121058360081665d3c7460#r40066039 >> Maybe we can just make the option msvc-build specific as a temporary >> workaround... >> >> Le mer. 12 août 2020 à 16:47, Eliot Miranda a >> écrit : >> >>> >>> Hi Tom, Hi Marcel, >>> >>> I also see that the mingw32/Cygwin/clang build is broken but the >>> MSVC/Clang build is not. >>> >>> If you use gdb to find out where the mingw32/Cygwin/clang breaks you >>> will see that it is in the zeroing of the stack zone memory after the >>> initial alloca of the stack zone. The stack pointer gets set to a lower >>> value by the alloca, as expected, but the stack memory is not committed so >>> when the memset starts writing to the memory pointed to by the stack >>> pointer it segfaults. >>> >>> I initially had the same problem with the MSVC/Clang build, but at a >>> different point, the JIT. The JIT stack allocates the memory it uses for >>> generating abstract instructions, etc, when generating machine code. It >>> can stack allocate over a megabyte. To fix the crash I used the linker’s >>> /STACK=size,committed flag to give the executable a 2mb fully committed >>> stack, and this fixed the crashes. >>> >>> I am using the MSVC/Clang build for Terf and we have had no problems >>> with the core VM since. However, in looking at SoundPlugin issues I did >>> try the mingw32/Cygwin/clang build last week and saw the stack zone alloca >>> crash that I expect is the cause of the breakage you observe. I did have >>> time to add a —stack size,committed flag to attempt to give the executable >>> a 2mb fully committed stack, but this did not work and did not fix the >>> crash, which remains in the same place. I conclude that the way I tried to >>> add the —stack size,committed flag is incorrect, although the linked did >>> not produce any error messages. >>> >>> I wish I had time to look at this but I don’t. If anyone does have >>> time, then my suggestion is to do a MSVC/Clang build alongside the >>> mingw32/Cygwin/clang one, and find out how to introspect the executable to >>> list its stack allocation parameters. I know that MSVC’s editbin can be >>> used to set these parameters but don’t know of a program to list them. One >>> obvious test is to use editbin to set the stack allocation parameters of >>> the mingw32/Cygwin/clang build. If my hypothesis is correct then it should >>> produce a vm that starts up, and then the attempt to fix is simple, find >>> out how to get the mingw32/Cygwin/clang linker to set correctly the stack >>> allocation parameters. >>> >>> HTH >>> >>> On May 18, 2020, at 11:40 PM, Marcel Taeumel >>> wrote: >>> >>>  >>> Hi Eliot, hi Tom, >>> >>> I reported this issue about a week ago: >>> https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498 >>> >>> Bintray version squeak.cog.spur_win64x64_202005170205 is still broken. >>> Segfaults on startup. >>> >>> Best, >>> Marcel >>> >>> Am 19.05.2020 01:02:06 schrieb Eliot Miranda : >>> >>> Hi Tom, >>> >>> >>> > On May 18, 2020, at 1:44 PM, Tom Beckmann wrote: >>> > >>> >  >>> > Hi everyone, >>> > >>> > I just tried building build.win64x64/squeak.cog.spur on the Cog branch >>> but got a segfault on startup. I then tentatively went back 10 commits >>> (HEAD~10) and it worked again. This is the output I received in gdb: >>> > >>> > Thread 1 received signal SIGSEGV, Segmentation fault. >>> > 0x00000000004016f3 in interpret () at >>> ../../spur64src/vm/gcc3x-cointerp.c:2809 >>> > 2809 memset(theStackMemory, 0, stackPagesBytes); >>> > (gdb) bt >>> > #0 0x00000000004016f3 in interpret () at >>> ../../spur64src/vm/gcc3x-cointerp.c:2809 >>> > #1 0x000000000052c34c in sqMain (argc=2, argv=0x1dd53a0) at >>> ../../platforms/win32/vm/sqWin32Main.c:1709 >>> > #2 0x000000000052c7f2 in WinMain (hInst=0x400000, hPrevInstance=0x0, >>> lpCmdLine=0xfc437c >>> "../../../Squeak6.0alpha-19582-64bit-202003021730-Windows/Squeak6.0alpha-19582-64bit.image", >>> nCmdShow=10) at ../../platforms/win32/vm/sqWin32Main.c:1802 >>> > #3 0x00000000004013c7 in __tmainCRTStartup () at >>> /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:339 >>> > #4 0x00000000004014cb in WinMainCRTStartup () at >>> /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:195 >>> > >>> > The main reason I'm writing, however, is that I only haven't done a >>> bisect yet because building the VM appears unusually slow, when compared to >>> building on Linux, as in, orders of magnitude slower. I believe I have the >>> same setup as we do on appveyor on windows using cygwin64. Incremental >>> builds seem to recompile a lot of files and it appears there are race >>> conditions when building with multiple threads (-j8). Are these known >>> limitations of the Windows build or am I potentially just having the wrong >>> setup? >>> >>> I hope it is simply wrong setup. I have been making these commits in >>> recent weeks in the context of getting 64-bit Terf working. Terf is 3D >>> ICC’s Croquet-derived business communications tool which was formerly known >>> as Teleplace and Qwaq forums and was the context in which OpenSmalltalk-vm >>> was conceived. >>> >>> I am building 64-bits using Clang 10 and MSVC and I assure you this >>> works. See HowToBuild for how to build using this configuration. >>> >>> Your configuration may be obsolete or it may be valid, and if valid we >>> should fix it. Can you list exactly what versions of software (Cygwin or >>> mingw, gcc, clang) you’re using your build? >>> >>> >>> > Thank you for any pointers! >>> > Tom >>> >>> Eliot >>> _,,,^..^,,,_ (phone) >>> >>> >>> >>> Eliot >>> _,,,^..^,,,_ (phone) >>> >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicolas.cellier.aka.nice at gmail.com Wed Aug 12 16:37:06 2020 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Wed, 12 Aug 2020 18:37:06 +0200 Subject: [Vm-dev] Win64 Builds broken, slow build times? In-Reply-To: References: Message-ID: Sorry to fragment the thread like this, but maybe this helps too: https://stackoverflow.com/questions/52406183/mingw-stack-size-reserved-or-committed Le mer. 12 août 2020 à 18:32, Nicolas Cellier < nicolas.cellier.aka.nice at gmail.com> a écrit : > So the question is why is -mno-stack-arg-probe required, optimization > apart? > If for no other purpose than optimization, we shall better remove this > form cygwin build, until we find out how to reserve (committed) stack > space... > > Le mer. 12 août 2020 à 17:42, Nicolas Cellier < > nicolas.cellier.aka.nice at gmail.com> a écrit : > >> From https://archive.is/J01oT, my understanding is that if we remove >> stack-probe, then we are not anymore protected from a stack overflow when >> trying to allocate more than a page size on stack... >> Does it help? >> >> Le mer. 12 août 2020 à 17:06, Nicolas Cellier < >> nicolas.cellier.aka.nice at gmail.com> a écrit : >> >>> Hi Eliot, >>> also, did you see my comment >>> https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498#issuecomment-647189330 >>> removing -mno-stack-arg-probe option from the makefile solves the >>> cygwin build. >>> See also >>> https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/920248dc54ecbcadd9121058360081665d3c7460#r40066039 >>> Maybe we can just make the option msvc-build specific as a temporary >>> workaround... >>> >>> Le mer. 12 août 2020 à 16:47, Eliot Miranda a >>> écrit : >>> >>>> >>>> Hi Tom, Hi Marcel, >>>> >>>> I also see that the mingw32/Cygwin/clang build is broken but the >>>> MSVC/Clang build is not. >>>> >>>> If you use gdb to find out where the mingw32/Cygwin/clang breaks you >>>> will see that it is in the zeroing of the stack zone memory after the >>>> initial alloca of the stack zone. The stack pointer gets set to a lower >>>> value by the alloca, as expected, but the stack memory is not committed so >>>> when the memset starts writing to the memory pointed to by the stack >>>> pointer it segfaults. >>>> >>>> I initially had the same problem with the MSVC/Clang build, but at a >>>> different point, the JIT. The JIT stack allocates the memory it uses for >>>> generating abstract instructions, etc, when generating machine code. It >>>> can stack allocate over a megabyte. To fix the crash I used the linker’s >>>> /STACK=size,committed flag to give the executable a 2mb fully committed >>>> stack, and this fixed the crashes. >>>> >>>> I am using the MSVC/Clang build for Terf and we have had no problems >>>> with the core VM since. However, in looking at SoundPlugin issues I did >>>> try the mingw32/Cygwin/clang build last week and saw the stack zone alloca >>>> crash that I expect is the cause of the breakage you observe. I did have >>>> time to add a —stack size,committed flag to attempt to give the executable >>>> a 2mb fully committed stack, but this did not work and did not fix the >>>> crash, which remains in the same place. I conclude that the way I tried to >>>> add the —stack size,committed flag is incorrect, although the linked did >>>> not produce any error messages. >>>> >>>> I wish I had time to look at this but I don’t. If anyone does have >>>> time, then my suggestion is to do a MSVC/Clang build alongside the >>>> mingw32/Cygwin/clang one, and find out how to introspect the executable to >>>> list its stack allocation parameters. I know that MSVC’s editbin can be >>>> used to set these parameters but don’t know of a program to list them. One >>>> obvious test is to use editbin to set the stack allocation parameters of >>>> the mingw32/Cygwin/clang build. If my hypothesis is correct then it should >>>> produce a vm that starts up, and then the attempt to fix is simple, find >>>> out how to get the mingw32/Cygwin/clang linker to set correctly the stack >>>> allocation parameters. >>>> >>>> HTH >>>> >>>> On May 18, 2020, at 11:40 PM, Marcel Taeumel >>>> wrote: >>>> >>>>  >>>> Hi Eliot, hi Tom, >>>> >>>> I reported this issue about a week ago: >>>> https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498 >>>> >>>> Bintray version squeak.cog.spur_win64x64_202005170205 is still broken. >>>> Segfaults on startup. >>>> >>>> Best, >>>> Marcel >>>> >>>> Am 19.05.2020 01:02:06 schrieb Eliot Miranda : >>>> >>>> Hi Tom, >>>> >>>> >>>> > On May 18, 2020, at 1:44 PM, Tom Beckmann wrote: >>>> > >>>> >  >>>> > Hi everyone, >>>> > >>>> > I just tried building build.win64x64/squeak.cog.spur on the Cog >>>> branch but got a segfault on startup. I then tentatively went back 10 >>>> commits (HEAD~10) and it worked again. This is the output I received in gdb: >>>> > >>>> > Thread 1 received signal SIGSEGV, Segmentation fault. >>>> > 0x00000000004016f3 in interpret () at >>>> ../../spur64src/vm/gcc3x-cointerp.c:2809 >>>> > 2809 memset(theStackMemory, 0, stackPagesBytes); >>>> > (gdb) bt >>>> > #0 0x00000000004016f3 in interpret () at >>>> ../../spur64src/vm/gcc3x-cointerp.c:2809 >>>> > #1 0x000000000052c34c in sqMain (argc=2, argv=0x1dd53a0) at >>>> ../../platforms/win32/vm/sqWin32Main.c:1709 >>>> > #2 0x000000000052c7f2 in WinMain (hInst=0x400000, hPrevInstance=0x0, >>>> lpCmdLine=0xfc437c >>>> "../../../Squeak6.0alpha-19582-64bit-202003021730-Windows/Squeak6.0alpha-19582-64bit.image", >>>> nCmdShow=10) at ../../platforms/win32/vm/sqWin32Main.c:1802 >>>> > #3 0x00000000004013c7 in __tmainCRTStartup () at >>>> /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:339 >>>> > #4 0x00000000004014cb in WinMainCRTStartup () at >>>> /usr/src/debug/mingw64-x86_64-runtime-7.0.0-1/crt/crtexe.c:195 >>>> > >>>> > The main reason I'm writing, however, is that I only haven't done a >>>> bisect yet because building the VM appears unusually slow, when compared to >>>> building on Linux, as in, orders of magnitude slower. I believe I have the >>>> same setup as we do on appveyor on windows using cygwin64. Incremental >>>> builds seem to recompile a lot of files and it appears there are race >>>> conditions when building with multiple threads (-j8). Are these known >>>> limitations of the Windows build or am I potentially just having the wrong >>>> setup? >>>> >>>> I hope it is simply wrong setup. I have been making these commits in >>>> recent weeks in the context of getting 64-bit Terf working. Terf is 3D >>>> ICC’s Croquet-derived business communications tool which was formerly known >>>> as Teleplace and Qwaq forums and was the context in which OpenSmalltalk-vm >>>> was conceived. >>>> >>>> I am building 64-bits using Clang 10 and MSVC and I assure you this >>>> works. See HowToBuild for how to build using this configuration. >>>> >>>> Your configuration may be obsolete or it may be valid, and if valid we >>>> should fix it. Can you list exactly what versions of software (Cygwin or >>>> mingw, gcc, clang) you’re using your build? >>>> >>>> >>>> > Thank you for any pointers! >>>> > Tom >>>> >>>> Eliot >>>> _,,,^..^,,,_ (phone) >>>> >>>> >>>> >>>> Eliot >>>> _,,,^..^,,,_ (phone) >>>> >>> -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Thu Aug 13 02:35:14 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 13 Aug 2020 02:35:14 0000 Subject: [Vm-dev] VM Maker: VMMaker-dtl.418.mcz Message-ID: David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.418.mcz ==================== Summary ==================== Name: VMMaker-dtl.418 Author: dtl Time: 12 August 2020, 10:35:02.257 pm UUID: 39e895ba-407a-4226-ab73-3634b979ea77 Ancestors: VMMaker-dtl.417 VMMaker 4.19.2 In ObjectMemory, the expression "self sizeMask + self size4Bit)" is constant regardless of bytesPerWord, see interp.h for the declarations. In all cases, SIZE_MASK + SIZE_4_BIT equals 16rFC. Simplify accordingly. =============== Diff against VMMaker-dtl.417 =============== Item was changed: ----- Method: NewObjectMemory>>eeInstantiateAndInitializeClass:indexableSize: (in category 'interpreter access') ----- eeInstantiateAndInitializeClass: classPointer indexableSize: size "NOTE: This method supports the backward-compatible split instSize field of the class format word. The sizeHiBits will go away and other shifts change by 2 when the split fields get merged in an (incompatible) image change. Will *not* cause a GC. The instantiated object is initialized." | hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat | "cannot have a negative indexable field count" self assert: size >= 0. hash := self newObjectHash. classFormat := self formatOfClass: classPointer. "Low 2 bits are 0" header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset. header2 := classPointer. header3 := 0. sizeHiBits := (classFormat bitAnd: 16r60000) >> 9. cClass := header1 bitAnd: CompactClassMask. "compact class field from format word" + byteSize := (classFormat bitAnd: 16rFC) + sizeHiBits. - byteSize := (classFormat bitAnd: self sizeMask + self size4Bit) + sizeHiBits. "size in bytes -- low 2 bits are 0" "Note this byteSize comes from the format word of the class which is pre-shifted to 4 bytes per field. Need another shift for 8 bytes per word..." byteSize := byteSize << (self shiftForWord-2). format := classFormat >> 8 bitAnd: 15. self flag: #sizeLowBits. format < 8 ifTrue: [format = 6 ifTrue: ["long32 bitmaps" bm1 := self bytesPerWord-1. byteSize := byteSize + (size * 4) + bm1 bitAnd: self longSizeMask. "round up" binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes" "extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: (binc bitAnd: 4)] ifFalse: [byteSize := byteSize + (size * self bytesPerWord) "Arrays and 64-bit bitmaps"] ] ifFalse: ["Strings and Methods" bm1 := self bytesPerWord-1. byteSize := byteSize + size + bm1 bitAnd: self longSizeMask. "round up" binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes" "low bits of byte size go in format field" header1 := header1 bitOr: (binc bitAnd: 3) << 8. "extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: (binc bitAnd: 4)]. byteSize > 255 ifTrue: ["requires size header word" header3 := byteSize. header1 := header1] ifFalse: [header1 := header1 bitOr: byteSize]. header3 > 0 ifTrue: ["requires full header" hdrSize := 3] ifFalse: [cClass = 0 ifTrue: [hdrSize := 2] ifFalse: [hdrSize := 1]]. ^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format! Item was changed: ----- Method: NewObjectMemory>>eeInstantiateClass:indexableSize: (in category 'interpreter access') ----- eeInstantiateClass: classPointer indexableSize: size "NOTE: This method supports the backward-compatible split instSize field of the class format word. The sizeHiBits will go away and other shifts change by 2 when the split fields get merged in an (incompatible) image change. Will *not* cause a GC. Note that the instantiated object IS NOT FILLED and must be completed before returning it to Smalltalk. Since this call is used in routines that do just that we are safe. Break this rule and die." | hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat | "cannot have a negative indexable field count" self assert: size >= 0. hash := self newObjectHash. classFormat := self formatOfClass: classPointer. "Low 2 bits are 0" header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset. header2 := classPointer. header3 := 0. sizeHiBits := (classFormat bitAnd: 16r60000) >> 9. cClass := header1 bitAnd: CompactClassMask. "compact class field from format word" + byteSize := (classFormat bitAnd: 16rFC) + sizeHiBits. - byteSize := (classFormat bitAnd: self sizeMask + self size4Bit) + sizeHiBits. "size in bytes -- low 2 bits are 0" "Note this byteSize comes from the format word of the class which is pre-shifted to 4 bytes per field. Need another shift for 8 bytes per word..." byteSize := byteSize << (self shiftForWord-2). format := classFormat >> 8 bitAnd: 15. self flag: #sizeLowBits. format < 8 ifTrue: [format = 6 ifTrue: ["long32 bitmaps" bm1 := self bytesPerWord-1. byteSize := byteSize + (size * 4) + bm1 bitAnd: self longSizeMask. "round up" binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes" "extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: (binc bitAnd: 4)] ifFalse: [byteSize := byteSize + (size * self bytesPerWord) "Arrays and 64-bit bitmaps"] ] ifFalse: ["Strings and Methods" bm1 := self bytesPerWord-1. byteSize := byteSize + size + bm1 bitAnd: self longSizeMask. "round up" binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes" "low bits of byte size go in format field" header1 := header1 bitOr: (binc bitAnd: 3) << 8. "extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: (binc bitAnd: 4)]. byteSize > 255 ifTrue: ["requires size header word" header3 := byteSize. header1 := header1] ifFalse: [header1 := header1 bitOr: byteSize]. header3 > 0 ifTrue: ["requires full header" hdrSize := 3] ifFalse: [cClass = 0 ifTrue: [hdrSize := 2] ifFalse: [hdrSize := 1]]. ^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3! Item was changed: ----- Method: NewObjectMemory>>eeInstantiateSmallClass:sizeInBytes: (in category 'interpreter access') ----- eeInstantiateSmallClass: classPointer sizeInBytes: sizeInBytes "This version of instantiateClass assumes that the total object size is under 256 bytes, the limit for objects with only one or two header words. Note that the size is specified in bytes and should include 4 or 8 bytes for the base header word. NOTE this code will only work for sizes that are an integral number of words (like not a 32-bit LargeInteger in a 64-bit system). Will *not* cause a GC. Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak. Since this call is used in routines that do just that we are safe. Break this rule and die." | hash header1 header2 hdrSize | "size must be integral number of words" self assert: (sizeInBytes bitAnd: (self bytesPerWord-1)) = 0. hash := self newObjectHash. header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer). header2 := classPointer. hdrSize := (header1 bitAnd: CompactClassMask) > 0 "is this a compact class" ifTrue: [1] ifFalse: [2]. + header1 := header1 + (sizeInBytes - (header1 bitAnd: 16rFC)). - header1 := header1 + (sizeInBytes - (header1 bitAnd: self sizeMask+self size4Bit)). ^self eeAllocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0! Item was changed: ----- Method: ObjectMemory>>instantiateClass:indexableSize: (in category 'interpreter access') ----- instantiateClass: classPointer indexableSize: size "NOTE: This method supports the backward-compatible split instSize field of the class format word. The sizeHiBits will go away and other shifts change by 2 when the split fields get merged in an (incompatible) image change." | hash header1 header2 cClass byteSize format binc header3 hdrSize fillWord newObj sizeHiBits bm1 classFormat | DoAssertionChecks ifTrue: [size < 0 ifTrue: [self error: 'cannot have a negative indexable field count']]. hash := self newObjectHash. classFormat := self formatOfClass: classPointer. "Low 2 bits are 0" header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash << HashBitsOffset bitAnd: HashBits). header2 := classPointer. header3 := 0. sizeHiBits := (classFormat bitAnd: 16r60000) >> 9. cClass := header1 bitAnd: CompactClassMask. "compact class field from format word" + byteSize := (classFormat bitAnd: 16rFC) + sizeHiBits. - byteSize := (classFormat bitAnd: self sizeMask + self size4Bit) + sizeHiBits. "size in bytes -- low 2 bits are 0" "Note this byteSize comes from the format word of the class which is pre-shifted to 4 bytes per field. Need another shift for 8 bytes per word..." byteSize := byteSize << (self shiftForWord - 2). format := classFormat >> 8 bitAnd: 15. self flag: #sizeLowBits. format < 8 ifTrue: [format = 6 ifTrue: ["long32 bitmaps" bm1 := self bytesPerWord - 1. byteSize := byteSize + (size * 4) + bm1 bitAnd: self longSizeMask. "round up" binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes" "extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: (binc bitAnd: 4)] ifFalse: [byteSize := byteSize + (size * self bytesPerWord) "Arrays and 64-bit bitmaps"] ] ifFalse: ["Strings and Methods" bm1 := self bytesPerWord - 1. byteSize := byteSize + size + bm1 bitAnd: self longSizeMask. "round up" binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes" "low bits of byte size go in format field" header1 := header1 bitOr: (binc bitAnd: 3) << 8. "extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: (binc bitAnd: 4)]. byteSize > 255 ifTrue: ["requires size header word" header3 := byteSize. header1 := header1] ifFalse: [header1 := header1 bitOr: byteSize]. header3 > 0 ifTrue: ["requires full header" hdrSize := 3] ifFalse: [cClass = 0 ifTrue: [hdrSize := 2] ifFalse: [hdrSize := 1]]. format <= 4 ifTrue: ["if pointers, fill with nil oop" fillWord := nilObj] ifFalse: [fillWord := 0]. newObj := self allocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true with: fillWord. ^ newObj! Item was changed: ----- Method: ObjectMemory>>instantiateSmallClass:sizeInBytes: (in category 'interpreter access') ----- instantiateSmallClass: classPointer sizeInBytes: sizeInBytes "This version of instantiateClass assumes that the total object size is under 256 bytes, the limit for objects with only one or two header words. Note that the size is specified in bytes and should include 4 or 8 bytes for the base header word. NOTE this code will only work for sizes that are an integral number of words (like not a 32-bit LargeInteger in a 64-bit system). May cause a GC. Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak. Since this call is used in routines that do jsut that we are safe. Break this rule and die." | hash header1 header2 hdrSize | (sizeInBytes bitAnd: (self bytesPerWord - 1)) = 0 ifFalse: [self error: 'size must be integral number of words']. hash := self newObjectHash. header1 := (hash << HashBitsOffset bitAnd: HashBits) bitOr: (self formatOfClass: classPointer). header2 := classPointer. (header1 bitAnd: CompactClassMask) > 0 "is this a compact class" ifTrue: [hdrSize := 1] ifFalse: [hdrSize := 2]. + header1 := header1 + (sizeInBytes - (header1 bitAnd: 16rFC)). - header1 := header1 + (sizeInBytes - (header1 bitAnd: self sizeMask + self size4Bit)). ^ self allocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0 doFill: false with: 0! Item was changed: ----- Method: VMMaker class>>versionString (in category 'version testing') ----- versionString "VMMaker versionString" + ^'4.19.2'! - ^'4.19.1'! From ken.dickey at whidbey.com Fri Aug 14 20:10:55 2020 From: ken.dickey at whidbey.com (ken.dickey at whidbey.com) Date: Fri, 14 Aug 2020 13:10:55 -0700 Subject: [Vm-dev] vm-display-fbdev on Aarch64/RasPi Message-ID: Greetings, While I like the idea of SqueakNOS (Squeak on Bare Metal), having a short life I prefer to work on value added. The (old) idea being to use a "shim" OS which takes care of memory, networking, USB drivers and which I do not have to support. I basically develop on aarch64/arm64 chips, so naturally took a look at revitalizing the framebuffer display: vm-display-fbdev. Progress so far: I can run both Cuis and Squeak images on Rasperry Pi 3 under Alpine Linux, which is a very slim Linux using MUSL (vs libc) and busybox (vs many separate commands). Both stack and Cog VMs run. The VM _is_ the window system. You will need to build the VM. If any intrepid explorers out there wish to help out or just take a look, I have a repository with instructions and the fb-display-fbdev code: https://github.com/KenDickey/FBDevVM Also, the complete build tree for aarch64+MUSL+libevdev with updated mvm's: https://github.com/KenDickey/opensmalltalk-vm Bug reports (or better yet, fixes!) and help cleaning up the C code is very much appreciated! Enjoy! -KenD PS: Yes, the cursor looks funny. Early days.. -------------- next part -------------- A non-text attachment was scrubbed... Name: screen0.png Type: image/png Size: 153516 bytes Desc: not available URL: From commits at source.squeak.org Fri Aug 14 20:55:01 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 Aug 2020 20:55:01 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2787.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2787.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2787 Author: eem Time: 14 August 2020, 1:54:50.995494 pm UUID: a81bc75b-4cf1-42bc-969e-85d46c9f2a4c Ancestors: VMMaker.oscog-eem.2786 Add another convenience to InterpreterPlugin. methodReturnStringOrNil: answers nil for a null string, instead of failing. =============== Diff against VMMaker.oscog-eem.2786 =============== Item was added: + ----- Method: InterpreterPlugin>>methodReturnStringOrNil: (in category 'API access') ----- + methodReturnStringOrNil: cString + "methodReturnString: fails for a nil value; this convenience answers nil for a nil value." + + + cString + ifNil: [interpreterProxy methodReturnValue: interpreterProxy nilObject] + ifNotNil: [interpreterProxy methodReturnString: cString]! From commits at source.squeak.org Fri Aug 14 21:03:36 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 Aug 2020 21:03:36 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2788.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2788.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2788 Author: eem Time: 14 August 2020, 2:03:27.285203 pm UUID: 415b0c73-efcf-4a0f-b6dc-d7bf2fce2663 Ancestors: VMMaker.oscog-eem.2787 ...and apply it to the SoundPlugin. =============== Diff against VMMaker.oscog-eem.2787 =============== Item was changed: ----- Method: SoundPlugin>>primitiveGetDefaultSoundPlayer (in category 'primitives') ----- primitiveGetDefaultSoundPlayer "Answer a String with the operating system name of the default output device, or nil" "no arguments" + self methodReturnStringOrNil: self getDefaultSoundPlayer! - | cDeviceName | - - - "Get the answer." - cDeviceName := self getDefaultSoundPlayer. - cDeviceName = 0 ifTrue: - [^interpreterProxy methodReturnValue: interpreterProxy nilObject]. - - ^interpreterProxy methodReturnString: cDeviceName! Item was changed: ----- Method: SoundPlugin>>primitiveGetDefaultSoundRecorder (in category 'primitives') ----- primitiveGetDefaultSoundRecorder "Answer a String with the operating system name of the default input device, or nil" "no arguments" + self methodReturnStringOrNil: self getDefaultSoundRecorder! - | cDeviceName | - - - "Get the answer." - cDeviceName := self getDefaultSoundRecorder. - cDeviceName = 0 ifTrue: - [^interpreterProxy methodReturnValue: interpreterProxy nilObject]. - - ^interpreterProxy methodReturnString: cDeviceName! Item was changed: ----- Method: SoundPlugin>>primitiveGetSoundPlayerDeviceName (in category 'primitives') ----- primitiveGetSoundPlayerDeviceName "arguments: name(type, stack offset) deviceNumber(Integer, 0)" "answers a string or nil" + | deviceNumber | - | deviceNumber cDeviceName | - "Parse arguments" interpreterProxy methodArgumentCount = 1 ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. deviceNumber := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + self methodReturnStringOrNil: (self getSoundPlayerDeviceName: deviceNumber - 1)! - "Get the answer." - cDeviceName := self getSoundPlayerDeviceName: deviceNumber - 1. - cDeviceName = 0 ifTrue: - [^interpreterProxy methodReturnValue: interpreterProxy nilObject]. - - ^interpreterProxy methodReturnString: cDeviceName! Item was changed: ----- Method: SoundPlugin>>primitiveGetSoundRecorderDeviceName (in category 'primitives') ----- primitiveGetSoundRecorderDeviceName "arguments: name(type, stack offset) deviceNumber(Integer, 0)" "answers a string or nil" + | deviceNumber | - | deviceNumber cDeviceName | - "Parse arguments" interpreterProxy methodArgumentCount = 1 ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. deviceNumber := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + self methodReturnStringOrNil: (self getSoundRecorderDeviceName: deviceNumber - 1)! - "Get the answer." - cDeviceName := self getSoundRecorderDeviceName: deviceNumber - 1. - cDeviceName = 0 ifTrue: - [^interpreterProxy methodReturnValue: interpreterProxy nilObject]. - - ^interpreterProxy methodReturnString: cDeviceName! From commits at source.squeak.org Fri Aug 14 21:36:43 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 Aug 2020 21:36:43 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2789.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2789.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2789 Author: eem Time: 14 August 2020, 2:36:34.720705 pm UUID: 62e4213d-c35b-4aa0-8d16-49d19f53b989 Ancestors: VMMaker.oscog-eem.2788 Provide the InterpreterPlugin>>stackStringValue: convenience. Simplify and ake simulateable the SecurityPlugin using methodReturnString: =============== Diff against VMMaker.oscog-eem.2788 =============== Item was added: + ----- Method: InterpreterPlugin>>stackStringValue: (in category 'API access') ----- + stackStringValue: index + "Convenience to answer a given argument as a C string. + Fails if the argument is not a string or there is no memory." + + | obj sz dstPtr | + + obj := interpreterProxy stackValue: index. + (interpreterProxy isBytes: obj) ifFalse: + [interpreterProxy primitiveFailFor: PrimErrBadArgument. + ^nil]. + sz := interpreterProxy byteSizeOf: obj. + dstPtr := self malloc: sz+1. + dstPtr ifNil: + [interpreterProxy primitiveFailFor: PrimErrNoCMemory. + ^nil]. + self memcpy: dstPtr _: (interpreterProxy firstIndexableField: obj) _: sz. + dstPtr at: sz put: 0. + ^dstPtr! Item was added: + ----- Method: SecurityPlugin>>ioCanWriteImage (in category 'simulation') ----- + ioCanWriteImage + + ^true! Item was added: + ----- Method: SecurityPlugin>>ioDisableImageWrite (in category 'simulation') ----- + ioDisableImageWrite + ! Item was added: + ----- Method: SecurityPlugin>>ioGetSecureUserDirectory (in category 'simulation') ----- + ioGetSecureUserDirectory + + ^SecurityManager default primSecureUserDirectory! Item was added: + ----- Method: SecurityPlugin>>ioGetUntrustedUserDirectory (in category 'simulation') ----- + ioGetUntrustedUserDirectory + + ^SecurityManager default primUntrustedUserDirectory! Item was changed: ----- Method: SecurityPlugin>>primitiveCanWriteImage (in category 'primitives') ----- primitiveCanWriteImage + interpreterProxy methodReturnBool: self ioCanWriteImage! - interpreterProxy pop: 1. - interpreterProxy pushBool: (self cCode:'ioCanWriteImage()' inSmalltalk:[true])! Item was changed: ----- Method: SecurityPlugin>>primitiveDisableImageWrite (in category 'primitives') ----- primitiveDisableImageWrite + self ioDisableImageWrite! - self cCode: 'ioDisableImageWrite()'! Item was changed: ----- Method: SecurityPlugin>>primitiveGetSecureUserDirectory (in category 'primitives') ----- primitiveGetSecureUserDirectory "Primitive. Return the secure directory for the current user." + | dirName | - | dirName dirLen dirOop dirPtr | + + dirName := self ioGetSecureUserDirectory. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnString: dirName]! - - - dirName := self cCode: 'ioGetSecureUserDirectory()' inSmalltalk: [nil]. - (dirName == nil or:[interpreterProxy failed]) - ifTrue:[^interpreterProxy primitiveFail]. - dirLen := self strlen: dirName. - dirOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: dirLen. - interpreterProxy failed ifTrue:[^nil]. - dirPtr := interpreterProxy firstIndexableField: dirOop. - 0 to: dirLen-1 do:[:i| - dirPtr at: i put: (dirName at: i)]. - interpreterProxy pop: 1 thenPush: dirOop.! Item was changed: ----- Method: SecurityPlugin>>primitiveGetUntrustedUserDirectory (in category 'primitives') ----- primitiveGetUntrustedUserDirectory "Primitive. Return the untrusted user directory name." + | dirName | - | dirName dirLen dirOop dirPtr | + + dirName := self ioGetUntrustedUserDirectory. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnString: dirName]! - - - dirName := self cCode:'ioGetUntrustedUserDirectory()' inSmalltalk:[nil]. - (dirName == nil or:[interpreterProxy failed]) - ifTrue:[^interpreterProxy primitiveFail]. - dirLen := self strlen: dirName. - dirOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: dirLen. - interpreterProxy failed ifTrue:[^nil]. - dirPtr := interpreterProxy firstIndexableField: dirOop. - 0 to: dirLen-1 do:[:i| - dirPtr at: i put: (dirName at: i)]. - interpreterProxy pop: 1 thenPush: dirOop.! From LEnglish5 at cox.net Sat Aug 15 01:04:37 2020 From: LEnglish5 at cox.net (LawsonEnglish) Date: Fri, 14 Aug 2020 18:04:37 -0700 Subject: [Vm-dev] Has anyone gotten FFI working on squeak on a Mac lately? Message-ID: I realize that the test library works, but I can’t use ANY kind of library user specified/user made library for FFI with Squeak on Catalina OR Mojave, and I can’t tell what I am doing wrong. I let Craig Latta watch me, via screen sharing on skype, set up the whole thing from scratch, and his response was to start to coach me in how to create and use the VM with a c-debugger. So I don’t think I’m doing anything obviously wrong or at least Craig didn’t catch it while he watched. Still don’t have the VM working, so I thought I ask if anyone has actually done it lately? The FFIPrim libray is in a .bundle, which may or may not be signficiant to this issue. L From eliot.miranda at gmail.com Sat Aug 15 01:19:32 2020 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Fri, 14 Aug 2020 18:19:32 -0700 Subject: [Vm-dev] vm-display-fbdev on Aarch64/RasPi In-Reply-To: References: Message-ID: <6FD877E6-AED4-4D20-846D-D72C172019BA@gmail.com> Hi Ken, > On Aug 14, 2020, at 1:19 PM, Ken.Dickey at whidbey.com wrote: > > Greetings, > > While I like the idea of SqueakNOS (Squeak on Bare Metal), having a short life I prefer to work on value added. > > The (old) idea being to use a "shim" OS which takes care of memory, networking, USB drivers and which I do not have to support. > > I basically develop on aarch64/arm64 chips, so naturally took a look at revitalizing the framebuffer display: vm-display-fbdev. > > Progress so far: > I can run both Cuis and Squeak images on Rasperry Pi 3 under Alpine Linux, which is a very slim Linux using MUSL (vs libc) and busybox (vs many separate commands). Both stack and Cog VMs run. Super cool! Looking forward to using this on Mankato with console login. > > The VM _is_ the window system. You will need to build the VM. And so one could launch squeak instead of X11 and post boot get straight there? Fab! Commiting should be like voting, early and often :-). Looking forward to integrating this. Thx!!! > If any intrepid explorers out there wish to help out or just take a look, I have a repository with instructions and the fb-display-fbdev code: > https://github.com/KenDickey/FBDevVM > > Also, the complete build tree for aarch64+MUSL+libevdev with updated mvm's: > https://github.com/KenDickey/opensmalltalk-vm > > Bug reports (or better yet, fixes!) and help cleaning up the C code is very much appreciated! > > Enjoy! > -KenD > > PS: Yes, the cursor looks funny. Early days.. Eliot _,,,^..^,,,_ (phone) > > From eliot.miranda at gmail.com Sun Aug 16 04:52:47 2020 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Sat, 15 Aug 2020 21:52:47 -0700 Subject: [Vm-dev] [squeak-dev] Has anyone gotten FFI working on squeak on a Mac lately? In-Reply-To: References: Message-ID: <63A94871-C477-4458-B480-84F67F33AD6B@gmail.com> Hi Lawson, > On Aug 15, 2020, at 1:54 PM, LawsonEnglish wrote: > > A followup issue is that simply getting the “External module not found” error the way I do eventually caues either a freeze, or a crash on startup. > > That’s happened with 3 different all-in-one Squeak 5.3’s. > > The debug VM also eventually freezes it seems, when I left it unattended overnight after trying to run that FFI call and getting that error. So far we haven’t figured out where to put a break in the C code to halt just before that error emerges, but just getting that error enough times seems to have its own bad effects on squeak, even if it takes a while to show up. Remember that if you run the vm from a terminal window then when it freezes up you can open another terminal and attach to the process using lldb abd then start exploring, eg using call printAllStacks() and call dumpPrimTraceLog() to find out what state it is in and what was the last external primitive it executed before locking up. You can also simply open a terminal and use pushOutputFile to send output to the new terminal, but that’s a bit involved. > L > >> On Aug 14, 2020, at 9:19 PM, Eliot Miranda wrote: >> >> Hi Lawson, >> >>>> On Aug 14, 2020, at 6:21 PM, LawsonEnglish wrote: >>> >>> I’m not saying it isn’t stable. >> >> I know. I was just saying I don’t think anything has been broken recently, so the issue is not in the FFI per se. >> >>> However, the test functions are in the FFI plugin, which is a .bundle. I’ve been trying to use a .dylib. >> >> There’s a SqueakFFIPlugin dylib (a dylib in all but name) in SqueakFFIPlugin.bundle/Contents/MacOS/SqueakFFIPlugin. That’s what the FFI actually loads. >> >>> I realize that this should. make no difference, and yet, as I said, Craig Latta watched me do the whole thing from scratch via skype screensharing and he didn’t see an error. >>> >>> SO again: has anyone used a non-Squeak distribution/non-bundle with FFI lately? >> >> Yes. >> >>> I tested it on both Catlaina and Mojave and I get teh External module not found error, even with my own .dylib that isn’t hardcoded to sit in a specific directory. >>> >>> WHich leads to a suggestion: if it really is a Mac OS x issue, rather than my own stupidity, it may be necessary to start testing against a library that is merely sitting in the Resource directory, rather than inside a .bundle. >>> >>> WHich is why I’m still asking: has anyone used their own library (outside a .bundle) with FFI lately on Mac OS X, Catalina OR Mojave? >> >> Yes, and it is extremely tricky. I’ve been using libav and libffmpeg and others. I’ve found one has to examine carefully the output of otool -L and use install_name_tool to change the hard-coded paths of any other non-system Dublin’s a Bykov depends on and make sure one understands and uses @rpath. If your dylib uses any other dylib you’re going to have to do the same exploration. >> >>> >>> I’m still trying to figure out how to PUT a library into a .bundle, or I’d test my theory. >> >> Look at the vm build makefiles for macos; they do this and they can be configured to generate dylibs in a directory, etc. >> >> So first question, what’s the output of >> otool -L mylib >> >> (You can omit all the /System/Library ones) >> >>> L >>> >>>> On Aug 14, 2020, at 6:14 PM, Eliot Miranda wrote: >>>> >>>> Hi Lawson, >>>> >>>>>> On Aug 14, 2020, at 6:04 PM, LawsonEnglish wrote: >>>>> >>>>> I realize that the test library works, but I can’t use ANY kind of library user specified/user made library for FFI with Squeak on Catalina OR Mojave, and I can’t tell what I am doing wrong. >>>>> >>>>> I let Craig Latta watch me, via screen sharing on skype, set up the whole thing from scratch, and his response was to start to coach me in how to create and use the VM with a c-debugger. >>>>> >>>>> So I don’t think I’m doing anything obviously wrong or at least Craig didn’t catch it while he watched. >>>>> >>>>> Still don’t have the VM working, so I thought I ask if anyone has actually done it lately? The FFIPrim libray is in a .bundle, which may or may not be signficiant to this issue. >>>> >>>> The FFI tests work out if the biz for me on MacOS 64-bit. The test functions are included in the FFI plugin. I haven’t tried x86/32-bit in a while but I’d be surprised if this was broken. The code is stable. >>>> >>>>> >>>>> >>>>> L >>>>> >>>> >>> >>> >> > > From commits at source.squeak.org Sun Aug 16 23:26:08 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 Aug 2020 23:26:08 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2790.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2790.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2790 Author: eem Time: 16 August 2020, 4:25:54.430017 pm UUID: c254cfd5-e456-417a-bad8-bb026d11b73e Ancestors: VMMaker.oscog-eem.2789 Interpreter cleanup Eliminate assertClassOf:is:. Delete obsolete primitiveVMProfileInfoInto. Simplify bytecodePrimPointX/Y to avoid primFailCode. =============== Diff against VMMaker.oscog-eem.2789 =============== Item was changed: ----- Method: InterpreterPrimitives>>primitiveImageName (in category 'other primitives') ----- primitiveImageName + "When called with a single string argument, record the string as the current image file name. + When called with zero arguments, return a string containing the current image file name." - "When called with a single string argument, record the string as the current image file name. When called with zero arguments, return a string containing the current image file name." + | s isString sCRIfn okToRename sz | + + argumentCount = 1 ifTrue: + [s := self stackTop. + isString := self isInstanceOfClassByteString: s. + isString ifFalse: + [^self primitiveFailFor: PrimErrBadArgument]. - | s sz sCRIfn okToRename | - - argumentCount = 1 ifTrue: [ "If the security plugin can be loaded, use it to check for rename permission. + If not, assume it's ok" - If not, assume it's ok" sCRIfn := self ioLoadFunction: 'secCanRenameImage' From: 'SecurityPlugin'. sCRIfn ~= 0 ifTrue: [okToRename := self cCode: '((sqInt (*)(void))sCRIfn)()' inSmalltalk: [self dispatchMappedPluginEntry: sCRIfn]. + okToRename ifFalse: + [^self primitiveFailFor: PrimErrUnsupported]]. + self imageNamePut: (s + objectMemory baseHeaderSize) Length: (objectMemory numBytesOf: s). + ^self pop: 1]. "pop s, leave rcvr on stack" + + "A char *ioImageName(void) style interface would be less cumbersome." + sz := self imageNameSize. + s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz. + self imageNameGet: (s + objectMemory baseHeaderSize) Length: sz. + self methodReturnValue: s! - okToRename ifFalse: - [^self primitiveFail]]. - s := self stackTop. - self assertClassOf: s is: (objectMemory splObj: ClassByteString). - self successful ifTrue: [ - sz := self stSizeOf: s. - self imageNamePut: (s + objectMemory baseHeaderSize) Length: sz. - self pop: 1. "pop s, leave rcvr on stack" - ]. - ] ifFalse: [ - sz := self imageNameSize. - s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz. - self imageNameGet: (s + objectMemory baseHeaderSize) Length: sz. - self pop: 1 thenPush: s - ]! Item was removed: - ----- Method: InterpreterPrimitives>>primitiveVMProfileInfoInto (in category 'process primitives') ----- - primitiveVMProfileInfoInto - "Primitive. Answer whether the profiler is running or not. - If the argument is an Array of suitable size fill it with the following information: - 1. the addresses of the first element of the VM histogram (the first address in the executable) - 2. the address following the last element (the last address in the executable, excluding dynamically linked libraries) - 3. the size of the VM histogram in bins (each bin is a 4 byte unsigned long) - 4. the size of the VM histogram in bins (each bin is a 4 byte unsigned long)" - | info running exeStart exeLimit vmBins easBins | - - - - - self success: argumentCount = 1. - self successful ifTrue: - [info := self stackObjectValue: 0]. - self successful ifTrue: - [info ~= objectMemory nilObject ifTrue: - [self assertClassOf: info is: (objectMemory splObj: ClassArray). - self success: (objectMemory numSlotsOf: info) >= 4]]. - self successful ifFalse: - [^nil]. - - self cCode: 'ioProfileStatus(&running,&exeStart,&exeLimit,0,&vmBins,0,&easBins)' - inSmalltalk: [running := exeStart := exeLimit := vmBins := easBins := 0]. - info ~= objectMemory nilObject ifTrue: - [objectMemory storePointerUnchecked: 0 - ofObject: info - withValue: (objectMemory integerObjectOf: (self oopForPointer: exeStart)). - objectMemory storePointerUnchecked: 1 - ofObject: info - withValue: (objectMemory integerObjectOf: (self oopForPointer: exeLimit)). - objectMemory storePointerUnchecked: 2 - ofObject: info - withValue: (objectMemory integerObjectOf: vmBins). - objectMemory storePointerUnchecked: 3 - ofObject: info - withValue: (objectMemory integerObjectOf: easBins)]. - self pop: 2 thenPushBool: running! Item was removed: - ----- Method: StackInterpreter>>assertClassOf:is: (in category 'utilities') ----- - assertClassOf: oop is: classOop - "Succeed if oop is an instance of the given class. Fail if the object is an integer." - | ok | - - ok := objectMemory isNonImmediate: oop. - ok ifTrue: - [ok := objectMemory isClassOfNonImm: oop equalTo: classOop]. - self success: ok! Item was changed: ----- Method: StackInterpreter>>bytecodePrimPointX (in category 'common selector sends') ----- bytecodePrimPointX + | rcvr ok | - | rcvr | self initPrimCall. rcvr := self internalStackTop. + (objectMemory isNonImmediate: rcvr) ifTrue: + [ok := objectMemory isClassOfNonImm: rcvr equalTo: (objectMemory splObj: ClassPoint). + ok ifTrue: + [self internalStackTopPut: (objectMemory fetchPointer: XIndex ofObject: rcvr). + ^self fetchNextBytecode]]. - self assertClassOf: rcvr is: (objectMemory splObj: ClassPoint). - self successful ifTrue: - [self internalStackTopPut: (objectMemory fetchPointer: XIndex ofObject: rcvr). - ^self fetchNextBytecode "success"]. - primFailCode := 0. messageSelector := self specialSelector: 30. argumentCount := 0. self normalSend! Item was changed: ----- Method: StackInterpreter>>bytecodePrimPointY (in category 'common selector sends') ----- bytecodePrimPointY + | rcvr ok | - | rcvr | self initPrimCall. rcvr := self internalStackTop. + (objectMemory isNonImmediate: rcvr) ifTrue: + [ok := objectMemory isClassOfNonImm: rcvr equalTo: (objectMemory splObj: ClassPoint). + ok ifTrue: + [self internalStackTopPut: (objectMemory fetchPointer: YIndex ofObject: rcvr). + ^self fetchNextBytecode]]. - self assertClassOf: rcvr is: (objectMemory splObj: ClassPoint). - self successful ifTrue: - [self internalStackTopPut: (objectMemory fetchPointer: YIndex ofObject: rcvr). - ^self fetchNextBytecode "success"]. - primFailCode := 0. messageSelector := self specialSelector: 31. argumentCount := 0. self normalSend! From noreply at github.com Sun Aug 16 23:46:05 2020 From: noreply at github.com (Eliot Miranda) Date: Sun, 16 Aug 2020 16:46:05 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 985c77: CogVM source as per VMMaker.oscog-eem.2790 Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 985c7706236e8cb34b668496b6883a969875c57b https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/985c7706236e8cb34b668496b6883a969875c57b Author: Eliot Miranda Date: 2020-08-16 (Sun, 16 Aug 2020) Changed paths: M nsspur64src/vm/cogit.h M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c M platforms/Cross/vm/sq.h M platforms/iOS/vm/iPhone/Classes/sqSqueakIPhoneApplication.m M platforms/minheadless/generic/sqPlatformSpecific-Generic.c M platforms/minheadless/unix/sqPlatformSpecific-Unix.c M platforms/minheadless/windows/sqPlatformSpecific-Win32.c M platforms/win32/vm/sqWin32VMProfile.c M spur64src/vm/cogit.h M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cogit.h M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cogit.h M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spurlowcodestack64src/vm/gcc3x-interp.c M spurlowcodestack64src/vm/interp.c M spurlowcodestacksrc/vm/gcc3x-interp.c M spurlowcodestacksrc/vm/interp.c M spursista64src/vm/cogit.h M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstack64src/vm/validImage.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M spurstacksrc/vm/validImage.c M src/ckformat.c M src/plugins/SecurityPlugin/SecurityPlugin.c M src/plugins/SoundPlugin/SoundPlugin.c M src/vm/cogit.h M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c M stacksrc/vm/gcc3x-interp.c M stacksrc/vm/interp.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.2790 Interpreter cleanup Eliminate assertClassOf:is:. Delete obsolete primitiveVMProfileInfoInto. Simplify bytecodePrimPointX/Y to avoid primFailCode. Provide the InterpreterPlugin>>stackStringValue: convenience. Simplify the SecurityPlugin using methodReturnString: From builds at travis-ci.org Mon Aug 17 00:10:14 2020 From: builds at travis-ci.org (Travis CI) Date: Mon, 17 Aug 2020 00:10:14 +0000 Subject: [Vm-dev] Errored: OpenSmalltalk/opensmalltalk-vm#2138 (Cog - 985c770) In-Reply-To: Message-ID: <5f39cae67102f_13fe1c9ead8609176e@travis-tasks-68b849f5f7-lm4d7.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2138 Status: Errored Duration: 23 mins and 34 secs Commit: 985c770 (Cog) Author: Eliot Miranda Message: CogVM source as per VMMaker.oscog-eem.2790 Interpreter cleanup Eliminate assertClassOf:is:. Delete obsolete primitiveVMProfileInfoInto. Simplify bytecodePrimPointX/Y to avoid primFailCode. Provide the InterpreterPlugin>>stackStringValue: convenience. Simplify the SecurityPlugin using methodReturnString: View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/2a7b21ed7570...985c7706236e View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/718461329?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 12:15:53 2020 From: notifications at github.com (Christoph Thiede) Date: Tue, 18 Aug 2020 05:15:53 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: Hi David, thanks for your interest and sorry for the delay, I was on holiday! > what exactly did you test please ? As you wrote, you can drag a file into the image and an external drop handler will handle it (or a dialog window will appear if there are multiple handlers). You can also drag multiple files into the image and they will be processed sequentially. So this is the only "acceptance test" I did so far. >From a lower-level perspective, you can manipulate `HandMorph >> #generateDropFilesEvent:` and insert a `Transcript showln: {dragType. numFiles}.` somewhere to watch the exact events generated by the VM. This PR removes duplicate/wrong events from the recorded list. You can also make sure that the following works: - drag a file over the image, but do not drop it, then drag it away - does the image still work? - after that, drag another file into the image and drop it - is the correct file displayed? - try to drag some text into the image - this attempt should be rejected but the image should still accept other files after that > But essentially I wonder (from the discussion) so far, what you are trying, to change with this dnd PR and how I could try to test it. In the first step, I only cleaned up the list of DND events generated by the X11 OSVM as described in the PR message. Depending on this PR, I am extending `#generateDropFilesEvent:` to also process the `DragMove` and `DragLeave` events. This allows it not only to drag files into the world itself but wrap them into a Squeak-like TransferMorph that can be dropped into morph or tool by reusing the existing `#acceptDroppingMorph:` interface. For example, you can drop a file directly into the Workspace without any other modifications. Marcel's idea! :-) > I don't seem to be able to drag anything out of Squeak. That's right, it might have worked on some platform in some ancient past, but nowadays it does not appear to work. But this would be interesting next steps, as well as dragging non-file stuff such as text or images into the image. Stay tuned! :-) Best, Christoph -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675442508 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:04:44 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:04:44 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I tested the following, with a VM compiled from the sqUnixXdnd branch: # git remote -v origin https://github.com/LinqLover/opensmalltalk-vm.git (fetch) origin https://github.com/LinqLover/opensmalltalk-vm.git (push) # git branch Cog * sqUnixXdnd Tested: 1. drag a file over the image, but do not drop it, then drag it away - does the image still work? Yes it works , the cursor temporarily changes to a 'drag with +' sign when, I drag the file1 over the VM display, and drag it away (without drop), and the Squeak VM continues to function. 2. after that, drag another file into the image and drop it - is the correct file displayed? Yes, I think so. I have files file1 and file2 and first drag file1 without drop, and then I drag file2, when I drop file2 it displays the file2 path. 3. try to drag some text into the image - this attempt should be rejected but the image should still accept other files after that The cursor changes again to a drag with "+" sign but when I drop the text, which I drag out of an external text editor, nothing seems to happen in Squeak. The image continues to accept other files after that. What also seems to work for me is to drag a folder (directory) into Squeak. I get some sort of Unix file browser for the files/directories in that folder (in Squeak). I think it is an interesting PR (pull request). But basically I don't understand what you are trying to fix. But obviously there must exist bugs in there ... However basically you seem to be "cleaning up" while I don't understand what effective bug you are trying to fix. Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAlVAAoJEAwpOKXMq1MaFXkIAMA8YImzs9vBj7J68M3guJdS +TfyKqjYaPJI6Vy+bcBeZxj9D2DlpqxG0AH/hRdccAFQ+iucql+ohJC4CeQ4CLT1 PlQjUfQO0XtShAkWCf1XP90PMbjaXZcnPfgCHCzC4XiDe09AVUeCSc0acwdg8JRe ZGkcWt/r+HxRVvLyAr83JcNRyUQwei5U3pf5LS5v/QLv1WeqdKZJPLfTbYg+VDVZ R0SZICNldynYBD1RInaiFiiwNknOI/CryAF8w/yj4zPV3trNDh3d54Yu1bgHdfj/ J05AD4vhGYNfUTzx+mn0Kz2vqb5k1RKWDgVX8yFJWI3cgqtTMjpcq0R0VBd7LFo= =lLKy -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675600340 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:04:57 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:04:57 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I tested the following, with a VM compiled from the sqUnixXdnd branch: # git remote -v origin https://github.com/LinqLover/opensmalltalk-vm.git (fetch) origin https://github.com/LinqLover/opensmalltalk-vm.git (push) # git branch Cog * sqUnixXdnd Tested: 1. drag a file over the image, but do not drop it, then drag it away - does the image still work? Yes it works , the cursor temporarily changes to a 'drag with +' sign when, I drag the file1 over the VM display, and drag it away (without drop), and the Squeak VM continues to function. 2. after that, drag another file into the image and drop it - is the correct file displayed? Yes, I think so. I have files file1 and file2 and first drag file1 without drop, and then I drag file2, when I drop file2 it displays the file2 path. 3. try to drag some text into the image - this attempt should be rejected but the image should still accept other files after that The cursor changes again to a drag with "+" sign but when I drop the text, which I drag out of an external text editor, nothing seems to happen in Squeak. The image continues to accept other files after that. What also seems to work for me is to drag a folder (directory) into Squeak. I get some sort of Unix file browser for the files/directories in that folder (in Squeak). I think it is an interesting PR (pull request). But basically I don't understand what you are trying to fix. But obviously there must exist bugs in there ... However basically you seem to be "cleaning up" while I don't understand what effective bug you are trying to fix. Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAlVAAoJEAwpOKXMq1MaFXkIAMA8YImzs9vBj7J68M3guJdS +TfyKqjYaPJI6Vy+bcBeZxj9D2DlpqxG0AH/hRdccAFQ+iucql+ohJC4CeQ4CLT1 PlQjUfQO0XtShAkWCf1XP90PMbjaXZcnPfgCHCzC4XiDe09AVUeCSc0acwdg8JRe ZGkcWt/r+HxRVvLyAr83JcNRyUQwei5U3pf5LS5v/QLv1WeqdKZJPLfTbYg+VDVZ R0SZICNldynYBD1RInaiFiiwNknOI/CryAF8w/yj4zPV3trNDh3d54Yu1bgHdfj/ J05AD4vhGYNfUTzx+mn0Kz2vqb5k1RKWDgVX8yFJWI3cgqtTMjpcq0R0VBd7LFo= =lLKy -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675600442 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:04:57 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:04:57 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I tested the following, with a VM compiled from the sqUnixXdnd branch: # git remote -v origin https://github.com/LinqLover/opensmalltalk-vm.git (fetch) origin https://github.com/LinqLover/opensmalltalk-vm.git (push) # git branch Cog * sqUnixXdnd Tested: 1. drag a file over the image, but do not drop it, then drag it away - does the image still work? Yes it works , the cursor temporarily changes to a 'drag with +' sign when, I drag the file1 over the VM display, and drag it away (without drop), and the Squeak VM continues to function. 2. after that, drag another file into the image and drop it - is the correct file displayed? Yes, I think so. I have files file1 and file2 and first drag file1 without drop, and then I drag file2, when I drop file2 it displays the file2 path. 3. try to drag some text into the image - this attempt should be rejected but the image should still accept other files after that The cursor changes again to a drag with "+" sign but when I drop the text, which I drag out of an external text editor, nothing seems to happen in Squeak. The image continues to accept other files after that. What also seems to work for me is to drag a folder (directory) into Squeak. I get some sort of Unix file browser for the files/directories in that folder (in Squeak). I think it is an interesting PR (pull request). But basically I don't understand what you are trying to fix. But obviously there must exist bugs in there ... However basically you seem to be "cleaning up" while I don't understand what effective bug you are trying to fix. Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAlVAAoJEAwpOKXMq1MaFXkIAMA8YImzs9vBj7J68M3guJdS +TfyKqjYaPJI6Vy+bcBeZxj9D2DlpqxG0AH/hRdccAFQ+iucql+ohJC4CeQ4CLT1 PlQjUfQO0XtShAkWCf1XP90PMbjaXZcnPfgCHCzC4XiDe09AVUeCSc0acwdg8JRe ZGkcWt/r+HxRVvLyAr83JcNRyUQwei5U3pf5LS5v/QLv1WeqdKZJPLfTbYg+VDVZ R0SZICNldynYBD1RInaiFiiwNknOI/CryAF8w/yj4zPV3trNDh3d54Yu1bgHdfj/ J05AD4vhGYNfUTzx+mn0Kz2vqb5k1RKWDgVX8yFJWI3cgqtTMjpcq0R0VBd7LFo= =lLKy -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675600441 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:05:07 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:05:07 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I tested the following, with a VM compiled from the sqUnixXdnd branch: # git remote -v origin https://github.com/LinqLover/opensmalltalk-vm.git (fetch) origin https://github.com/LinqLover/opensmalltalk-vm.git (push) # git branch Cog * sqUnixXdnd Tested: 1. drag a file over the image, but do not drop it, then drag it away - does the image still work? Yes it works , the cursor temporarily changes to a 'drag with +' sign when, I drag the file1 over the VM display, and drag it away (without drop), and the Squeak VM continues to function. 2. after that, drag another file into the image and drop it - is the correct file displayed? Yes, I think so. I have files file1 and file2 and first drag file1 without drop, and then I drag file2, when I drop file2 it displays the file2 path. 3. try to drag some text into the image - this attempt should be rejected but the image should still accept other files after that The cursor changes again to a drag with "+" sign but when I drop the text, which I drag out of an external text editor, nothing seems to happen in Squeak. The image continues to accept other files after that. What also seems to work for me is to drag a folder (directory) into Squeak. I get some sort of Unix file browser for the files/directories in that folder (in Squeak). I think it is an interesting PR (pull request). But basically I don't understand what you are trying to fix. But obviously there must exist bugs in there ... However basically you seem to be "cleaning up" while I don't understand what effective bug you are trying to fix. Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAlVAAoJEAwpOKXMq1MaFXkIAMA8YImzs9vBj7J68M3guJdS +TfyKqjYaPJI6Vy+bcBeZxj9D2DlpqxG0AH/hRdccAFQ+iucql+ohJC4CeQ4CLT1 PlQjUfQO0XtShAkWCf1XP90PMbjaXZcnPfgCHCzC4XiDe09AVUeCSc0acwdg8JRe ZGkcWt/r+HxRVvLyAr83JcNRyUQwei5U3pf5LS5v/QLv1WeqdKZJPLfTbYg+VDVZ R0SZICNldynYBD1RInaiFiiwNknOI/CryAF8w/yj4zPV3trNDh3d54Yu1bgHdfj/ J05AD4vhGYNfUTzx+mn0Kz2vqb5k1RKWDgVX8yFJWI3cgqtTMjpcq0R0VBd7LFo= =lLKy -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675600519 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:05:07 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:05:07 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I tested the following, with a VM compiled from the sqUnixXdnd branch: # git remote -v origin https://github.com/LinqLover/opensmalltalk-vm.git (fetch) origin https://github.com/LinqLover/opensmalltalk-vm.git (push) # git branch Cog * sqUnixXdnd Tested: 1. drag a file over the image, but do not drop it, then drag it away - does the image still work? Yes it works , the cursor temporarily changes to a 'drag with +' sign when, I drag the file1 over the VM display, and drag it away (without drop), and the Squeak VM continues to function. 2. after that, drag another file into the image and drop it - is the correct file displayed? Yes, I think so. I have files file1 and file2 and first drag file1 without drop, and then I drag file2, when I drop file2 it displays the file2 path. 3. try to drag some text into the image - this attempt should be rejected but the image should still accept other files after that The cursor changes again to a drag with "+" sign but when I drop the text, which I drag out of an external text editor, nothing seems to happen in Squeak. The image continues to accept other files after that. What also seems to work for me is to drag a folder (directory) into Squeak. I get some sort of Unix file browser for the files/directories in that folder (in Squeak). I think it is an interesting PR (pull request). But basically I don't understand what you are trying to fix. But obviously there must exist bugs in there ... However basically you seem to be "cleaning up" while I don't understand what effective bug you are trying to fix. Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAlVAAoJEAwpOKXMq1MaFXkIAMA8YImzs9vBj7J68M3guJdS +TfyKqjYaPJI6Vy+bcBeZxj9D2DlpqxG0AH/hRdccAFQ+iucql+ohJC4CeQ4CLT1 PlQjUfQO0XtShAkWCf1XP90PMbjaXZcnPfgCHCzC4XiDe09AVUeCSc0acwdg8JRe ZGkcWt/r+HxRVvLyAr83JcNRyUQwei5U3pf5LS5v/QLv1WeqdKZJPLfTbYg+VDVZ R0SZICNldynYBD1RInaiFiiwNknOI/CryAF8w/yj4zPV3trNDh3d54Yu1bgHdfj/ J05AD4vhGYNfUTzx+mn0Kz2vqb5k1RKWDgVX8yFJWI3cgqtTMjpcq0R0VBd7LFo= =lLKy -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675600518 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:14:28 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:14:28 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 By the way I did the same 3 tests with a VM which I compiled from the OpenSmalltalk Cog branch (not from the PR). I seem to be having the same results. David. -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAwiAAoJEAwpOKXMq1MaE+4H/RIo+hfJjnwlvuMkSoRkkayi uE2Qb/k8HnqKtH1Sz3r8xO77ciEcqctCqVzrpx5Z4iL0zhdQrpPHj5Ds7fBWU0lP SHPlA/RffxhMXutZPwPk5K9roreuA96E5c6xAgCl1nT45LtyaQGZLbn7enzlK4xp 9aeGK4E1fxdnu93qj3zPGb8jrpnE5KlN1YMs9Q0Ynt+nW/gcftAsAGGX/32nTnvA ipeSG5C8u9pdk3DCkdV8/LVrqlKWcWBnANEKcDw97Tr7zOlc4IIlFJAA1p2E+6Ns rOIF0YKBKGVix9kI+lvssVM4TT/q5gsNpz4vKMrc3SGGAi8r/OHNpWLWBotBlC0= =PSvQ -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675605340 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:15:19 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:15:19 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 By the way I did the same 3 tests with a VM which I compiled from the OpenSmalltalk Cog branch (not from the PR). I seem to be having the same results. David. -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAwiAAoJEAwpOKXMq1MaE+4H/RIo+hfJjnwlvuMkSoRkkayi uE2Qb/k8HnqKtH1Sz3r8xO77ciEcqctCqVzrpx5Z4iL0zhdQrpPHj5Ds7fBWU0lP SHPlA/RffxhMXutZPwPk5K9roreuA96E5c6xAgCl1nT45LtyaQGZLbn7enzlK4xp 9aeGK4E1fxdnu93qj3zPGb8jrpnE5KlN1YMs9Q0Ynt+nW/gcftAsAGGX/32nTnvA ipeSG5C8u9pdk3DCkdV8/LVrqlKWcWBnANEKcDw97Tr7zOlc4IIlFJAA1p2E+6Ns rOIF0YKBKGVix9kI+lvssVM4TT/q5gsNpz4vKMrc3SGGAi8r/OHNpWLWBotBlC0= =PSvQ -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675605753 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:15:20 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:15:20 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 By the way I did the same 3 tests with a VM which I compiled from the OpenSmalltalk Cog branch (not from the PR). I seem to be having the same results. David. -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAwiAAoJEAwpOKXMq1MaE+4H/RIo+hfJjnwlvuMkSoRkkayi uE2Qb/k8HnqKtH1Sz3r8xO77ciEcqctCqVzrpx5Z4iL0zhdQrpPHj5Ds7fBWU0lP SHPlA/RffxhMXutZPwPk5K9roreuA96E5c6xAgCl1nT45LtyaQGZLbn7enzlK4xp 9aeGK4E1fxdnu93qj3zPGb8jrpnE5KlN1YMs9Q0Ynt+nW/gcftAsAGGX/32nTnvA ipeSG5C8u9pdk3DCkdV8/LVrqlKWcWBnANEKcDw97Tr7zOlc4IIlFJAA1p2E+6Ns rOIF0YKBKGVix9kI+lvssVM4TT/q5gsNpz4vKMrc3SGGAi8r/OHNpWLWBotBlC0= =PSvQ -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675605756 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:15:20 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:15:20 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 By the way I did the same 3 tests with a VM which I compiled from the OpenSmalltalk Cog branch (not from the PR). I seem to be having the same results. David. -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAwiAAoJEAwpOKXMq1MaE+4H/RIo+hfJjnwlvuMkSoRkkayi uE2Qb/k8HnqKtH1Sz3r8xO77ciEcqctCqVzrpx5Z4iL0zhdQrpPHj5Ds7fBWU0lP SHPlA/RffxhMXutZPwPk5K9roreuA96E5c6xAgCl1nT45LtyaQGZLbn7enzlK4xp 9aeGK4E1fxdnu93qj3zPGb8jrpnE5KlN1YMs9Q0Ynt+nW/gcftAsAGGX/32nTnvA ipeSG5C8u9pdk3DCkdV8/LVrqlKWcWBnANEKcDw97Tr7zOlc4IIlFJAA1p2E+6Ns rOIF0YKBKGVix9kI+lvssVM4TT/q5gsNpz4vKMrc3SGGAi8r/OHNpWLWBotBlC0= =PSvQ -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675605759 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Tue Aug 18 17:15:51 2020 From: notifications at github.com (David Stes) Date: Tue, 18 Aug 2020 10:15:51 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 By the way I did the same 3 tests with a VM which I compiled from the OpenSmalltalk Cog branch (not from the PR). I seem to be having the same results. David. -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPAwiAAoJEAwpOKXMq1MaE+4H/RIo+hfJjnwlvuMkSoRkkayi uE2Qb/k8HnqKtH1Sz3r8xO77ciEcqctCqVzrpx5Z4iL0zhdQrpPHj5Ds7fBWU0lP SHPlA/RffxhMXutZPwPk5K9roreuA96E5c6xAgCl1nT45LtyaQGZLbn7enzlK4xp 9aeGK4E1fxdnu93qj3zPGb8jrpnE5KlN1YMs9Q0Ynt+nW/gcftAsAGGX/32nTnvA ipeSG5C8u9pdk3DCkdV8/LVrqlKWcWBnANEKcDw97Tr7zOlc4IIlFJAA1p2E+6Ns rOIF0YKBKGVix9kI+lvssVM4TT/q5gsNpz4vKMrc3SGGAi8r/OHNpWLWBotBlC0= =PSvQ -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-675606014 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Wed Aug 19 10:46:11 2020 From: notifications at github.com (Christoph Thiede) Date: Wed, 19 Aug 2020 03:46:11 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: Hi David, thanks for sharing your observations, this fits in with my own results. > By the way I did the same 3 tests with a VM which I compiled from the OpenSmalltalk Cog branch (not from the PR). > > I seem to be having the same results. So there appears not to be any regression. > But basically I don't understand what you are trying to fix. Here is how you can observe the erroneous under-the-hood behavior this PR aims to fix: 1. In a recent Squeak image, browse `HandMorph >> #generateDropFilesEvent:` and insert the following line after the assignment of `dragType:` ```smalltalk Transcript showln: dragType. ``` 2. Open a Transcript 3. Drag a file into the image Transcript output on an X11 platform using the latest released plugin version: ``` 1 (dragEnter) 2 (dragMove) 2 (dragMove) ... 2 (dragMove) 3 (dragLeave) 4 (dragDrop) 3 (dragLeave) ``` Transcript when compiling the plugin with the proposed patch applied: ``` 1 (dragEnter) 2 (dragMove) 2 (dragMove) ... 2 (dragMove) 4 (dragDrop) ``` The current image implementation does not care about the additional, false dragLeave events, but my changeset which I am planning to put into the inbox will do so. Is this comprehensible? 😅 PS: For some reasons all your posts arrive multiple times in the repository. Also, they would be easier to read if you could use codefences (` ``` `) :-) Best, Christoph -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-676129131 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Wed Aug 19 11:56:03 2020 From: notifications at github.com (Christoph Thiede) Date: Wed, 19 Aug 2020 04:56:03 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) Message-ID: This PR aligns the default `numFiles` value recorded for `DragEnter`, `DragMove`, and `DragLeave` events recorded by the X11 implementation of the DropPlugin, which was `1`, to the default value used by the Win32 implementation of the plugin, which is `0`. The motivation for this change is to unify the event protocol along with different platforms. It would technically be highly expensive and questionable to find out this value before the drop event has been recorded. Concretely, Win32 does not support this at all without switching the library, and on Linux, this would require a performance-extensive ping-pong of "Target to source: Please hand a copy of all dragged files", "Source to target: I converted these files for you", "Target to source: Thank you, but I was only interested into their total number" messages. (However, interestingly macOS appears to support this (I could not yet test it) and https://github.com/codefrau/SqueakJS/ could do so, too.) While pursuing the same master plan, this PR is not dependent nor reverse-dependent on #508. They can be merged independently of each other. Please review and merge if you agree. I hereby confirm that I did not observe any regressions when dragging files or folders into a recent Squeak image. You can view, comment on, or merge this pull request online at: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514 -- Commit Summary -- * X11 DropPlugin: Don't specify numFiles= 1 before DragDrop -- File Changes -- M platforms/unix/vm-display-X11/sqUnixXdnd.c (14) -- Patch Links -- https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514.patch https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514.diff -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Wed Aug 19 12:03:39 2020 From: notifications at github.com (Christoph Thiede) Date: Wed, 19 Aug 2020 05:03:39 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] Win32 event generation mixes up timeGetTime() and GetMessageTime() (#509) In-Reply-To: References: Message-ID: No one ever having dealt with Win32 event generation before? If someone with a bit more experience than me would agree to use of the two APIs everywhere, I could try my luck. My naive proposal would be to use `GetMessageTime()` everywhere because this would reduce the extent of code to update and minimize the overall changes. Or does anyone see a good reason not keep using `timeapi.h` anywhere? -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/509#issuecomment-676235214 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Wed Aug 19 16:55:54 2020 From: notifications at github.com (David Stes) Date: Wed, 19 Aug 2020 09:55:54 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 First of all, sorry if you receive this multiple times, most likely this is because I click the "Comment" button multiple times. OK, I modified the HandMorph -> private events -> generateDropFilesEvent: as you indicated, from the Squeak6.0alpha-19793-64bit.image for the tests. I also tried with Squeak 4, I have the same result when I try with the Squeak4.6-15012 (Squeak 4 VM). When I drag and drop a file "myfile" into the Squeak window, the Transcript shows: 1 2 2 ... 2 2 3 4 3 and the object for "myfile" is created. If I drag "myfile" into the Squeak window and then out of it (without drop): 1 2 2 ... 2 2 3 On the other hand if I use the VM, with this pull request, compiled : First when drag and drop "myfile" : 1 2 2 ... 2 2 4 Then when dragging "myfile" without drop : 1 2 2 ... 2 2 3 So this confirms what you described ... However to really test this pull request I think it is required to test the code (changeset) which you are planning to put into the "inbox". Maybe I missed something but in the description of this pull request, you could give a pointer to the changeset you are developing. Maybe if I can download it from some place, I can test it. I now realise that you are actually talking about a combination of 2 things. 1. a change in the VM 2. a changeset of some Squeak code that depends on that the VM change Correct ? If so, I'd certainly would be interested in trying out the changeset. Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPVl3AAoJEAwpOKXMq1MaVr8IAJLUPrZgBudoLM5GR7owR0/4 /vev7wuQvttCw3Sn1ib/G3podJywutiErXdugX3tA28hqyQvY9bFLzHK1+JjDyL1 ALhyg+uPzl+KOwtVEKBkAF2HO7dokDnr9eFIrSZyc917tb5IqnFW1yOBCdeVXqkn JCCIi0nmU4psafmdEk8gVbQb4PdkNtdrgSck1GO1N2VyAkhiHyMNv+dJZs3ES2NZ Id+t0+k3V1er5TJRnaOJj5vBluutMZqTD5yk4iZ1UGcR12wLgKGxENnFgLeIpPK0 WQI/0oHZUx8V5sP5id215U9bt/SkT8IXoDGQ54LC8Clv9JOjP6SkUH3K4j54Cs8= =a1r+ -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-676543318 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Wed Aug 19 17:16:52 2020 From: notifications at github.com (Christoph Thiede) Date: Wed, 19 Aug 2020 10:16:52 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: Thanks again for testing! :-) I can share with you a [working copy](https://github.com/OpenSmalltalk/opensmalltalk-vm/files/5098120/dropFiles3.27.zip) of my changeset, but it is still WIP. However, I am convinced that both changes in VM + image are decoupled enough and do not need to be released together. Even without any image change, I think that the old X11 event generation, saying "dragLeave dragDrop dragLeave" was erroneous by itself. >From my point of view, this PR is ready to merge as stated in July. :-) -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-676554176 -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Thu Aug 20 01:21:14 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 20 Aug 2020 01:21:14 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2791.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2791.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2791 Author: eem Time: 19 August 2020, 6:21:04.014485 pm UUID: 04cdce33-b4a9-4acb-982e-ed9393a1783b Ancestors: VMMaker.oscog-eem.2790 Looking at class indentityHash distributions in my current VMMaker image it is clear that setting the classTableIndex to point at the start of the last used page is not a good strategy, and leads to far too sparse a class table. So change the policy and set the classTableIndex to the first unused slot (unless bootstrapping). =============== Diff against VMMaker.oscog-eem.2790 =============== Item was changed: ----- Method: SpurMemoryManager>>setHiddenRootsObj: (in category 'class table') ----- setHiddenRootsObj: anOop hiddenRootsObj := anOop. self cCode: [self assert: self validClassTableRootPages] inSmalltalk: [numClassTablePages ifNotNil: [self assert: self validClassTableRootPages]]. classTableFirstPage := self fetchPointer: 0 ofObject: hiddenRootsObj. self assert: (self numSlotsOf: classTableFirstPage) - 1 = self classTableMinorIndexMask. "Hack fix. A bug in markAndTraceClassOf: caused the class of the first class table page to be changed from its pun. This can be restored manually, but we do it here too." self flag: 'remove at some stage'. (self classIndexOf: classTableFirstPage) ~= self arrayClassIndexPun ifTrue: [self setClassIndexOf: classTableFirstPage to: self arrayClassIndexPun]. - "Set classTableIndex to the start of the last used page (excepting first page). - Set numClassTablePages to the number of used pages." numClassTablePages := self classTableRootSlots. + self bootstrapping ifTrue: + ["Set classTableIndex to the start of the last used page (excepting first page). + Set numClassTablePages to the number of used pages." + 2 to: numClassTablePages - 1 do: + [:i| + (self fetchPointer: i ofObject: hiddenRootsObj) = nilObj ifTrue: + [numClassTablePages := i. + classTableIndex := (i - 1 max: 1) << self classTableMajorIndexShift. + ^self]]. + "no unused pages; set it to the start of the second page." + classTableIndex := 1 << self classTableMajorIndexShift. + ^self]. + "If loading an image, set the classTableIndex to the first unused slot in the class table after the first page. + Set numClassTablePages to the number of used pages. + Set classTableIndex to point at the first unused entry. First set it to the max as a sentinel." + classTableIndex := numClassTablePages << self classTableMajorIndexShift. + 1 to: numClassTablePages - 1 do: + [:i| | page j | + (page := self fetchPointer: i ofObject: hiddenRootsObj) = nilObj + ifFalse: + [classTableIndex >> self classTableMajorIndexShift > i ifTrue: + [j := 0. + [j < self classTablePageSize] whileTrue: + [(self fetchPointer: j ofObject: page) = nilObj ifTrue: + [classTableIndex := i << self classTableMajorIndexShift + j. + j := self classTablePageSize]. + j := j + 1]]] + ifTrue: + [classTableIndex >> self classTableMajorIndexShift > i ifTrue: + [classTableIndex := (i - 1 max: 1) << self classTableMajorIndexShift]. + numClassTablePages := i. + self assert: (self classOrNilAtIndex: classTableIndex) = nilObj. + ^self]]. + "no unused slots; set it to the start of the second page." + classTableIndex >> self classTableMajorIndexShift >= numClassTablePages ifTrue: + [classTableIndex := 1 << self classTableMajorIndexShift]. + self assert: (self classOrNilAtIndex: classTableIndex) = nilObj! - 2 to: numClassTablePages - 1 do: - [:i| - (self fetchPointer: i ofObject: hiddenRootsObj) = nilObj ifTrue: - [numClassTablePages := i. - classTableIndex := (numClassTablePages - 1 max: 1) << self classTableMajorIndexShift. - ^self]]. - "no unused pages; set it to the start of the second page." - classTableIndex := 1 << self classTableMajorIndexShift! From notifications at github.com Thu Aug 20 09:44:53 2020 From: notifications at github.com (David Stes) Date: Thu, 20 Aug 2020 02:44:53 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I'm just commenting on this out of interest, I cannot say anything on whether this PR is going to be merged, as I have nothing to do with that. As far as I can see this looks a reasonable change, but we don't know, how the original author(s) think about it, whether they had a reason for their implementation. But the context of your work is a little bit clearer now to me. Basically you have dropFiles-examples.13.cs dropFiles3.14.cs changesets. In my image I can "fileIn" those changesets by Tools->FileList and then clicking "fileIn". My understanding is now that you need some VM changes/support for the dropFiles3.14.cs changeset, i.e. the underlying VM has some behavior, that you want to change for the dropFiles changes. If it's useful I can do further testing on this X11 platform, as from what I understand this change is relevant to the Solaris X11 support. For the moment - this may be a Solaris specific problem - when I test, drag and drop after fileIn of the dropFiles changeset I get the following, in a debugger: - --- The full stack --- FileDirectory class>>requestDropDirectory: [] in HandMorph>>collectDropFilesAndDirectories: Interval>>collect: HandMorph>>collectDropFilesAndDirectories: HandMorph>>generateDropFilesEvent: HandMorph>>processEvents [] in WorldState>>doOneCycleNowFor: Array(SequenceableCollection)>>do: WorldState>>handsDo: WorldState>>doOneCycleNowFor: WorldState>>doOneCycleFor: PasteUpMorph>>doOneCycle [] in MorphicProject>>spawnNewProcess [] in FullBlockClosure(BlockClosure)>>newProcess There may be Solaris specific issues with the FileDirectory I don't know. David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPkVcAAoJEAwpOKXMq1MaPcAH/R0nTxahFVzPv6abeDbA9gMh GTKEXZBpQ/dEXCLedu1IVtUFnqqK2wdJJRt2HmhRZD3sxoT3YqnZfyJkip5A9mFt +npBuMRsCAAu2suvmOpUMJQK6HTb9/hAJiAgNEDSnQ9RUFutIBo0+6MEONGj8vGF WuJm31p9b8cAqLhi5twA3CcKC2P8PNkF+QS8RHDSO2SMJpEuGaTgxbCYkXJPEp15 o1cdZPqKcIlJGsf23B4V2XBWI38YxVOcMUS5CYzyACi8s/NnrCS5hNeAqzLX27QH dLhTZipSvQlcwkS7sz1X1Xm5soVmNbVwZIhkUK4ydmWGiElgbl0ZkQgJtijgY7k= =BNaM -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-677495161 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Thu Aug 20 11:23:39 2020 From: notifications at github.com (Christoph Thiede) Date: Thu, 20 Aug 2020 04:23:39 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: David, > My understanding is now that you need some VM changes/support for the dropFiles3.14.cs changeset, i.e. the underlying VM has some behavior, that you want to change for the dropFiles changes. Exactly. > For the moment - this may be a Solaris specific problem - when I test, drag and drop after fileIn of the dropFiles changeset I get the following, in a debugger: This could be interesting. May I assume that the VM you used was compiled based on this PR? What is the exact error message you see? I tested PR + changeset both in WSL + VcXsrv and a true Ubuntu VM and it worked fine for me. Maybe it's a Solaris problem, I don't know ... -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-677553371 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Thu Aug 20 12:26:11 2020 From: notifications at github.com (David Stes) Date: Thu, 20 Aug 2020 05:26:11 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I compiled the VM from your repository branch "sqUnixXdnd" (I applied one small patch the patch from PR #496 required on Solaris) It's possible that there is some issue with the Solaris support, as this has not been used for a long time I think, and I'm only recently using it , but it's quite usable. So when I use that VM and I use the Tools -> File List , I can "fileIn" the changesets that you posted. Then after that when I drag a file "myfile" into the Squeak desktop, I get into a debugger. When I right click on the debugger I can select "copy bug report to clipboard". UndefinedObject(Object)>>error: Receiver: nil Arguments and temporary variables: aString: 'Instances of UndefinedObject are not indexable' Receiver's instance variables: nil UndefinedObject(Object)>>errorNotIndexable Receiver: nil Arguments and temporary variables: Receiver's instance variables: nil UndefinedObject(Object)>>size Receiver: nil Arguments and temporary variables: Receiver's instance variables: nil FileDirectory class>>on: Receiver: FileDirectory Arguments and temporary variables: pathString: nil pathName: nil parentName: nil Receiver's instance variables: superclass: Object methodDict: a MethodDictionary(size 125) format: 65537 instanceVariables: #('pathName') organization: ('enumeration' containingDirectory directoryEntries directoryEntry...etc... subclasses: {UnixFileDirectory . AcornFileDirectory . MacFileDirectory . DosFileDirectory...etc... name: #FileDirectory classPool: a Dictionary(#DefaultDirectory->UnixFileDirectory on './stes/s...etc... sharedPools: nil environment: Smalltalk category: #'Files-Directories' FileDirectory class>>requestDropDirectory: Receiver: FileDirectory Arguments and temporary variables: dropIndex: 1 potentialDirectory: nil Receiver's instance variables: superclass: Object methodDict: a MethodDictionary(size 125) format: 65537 instanceVariables: #('pathName') organization: ('enumeration' containingDirectory directoryEntries directoryEntry...etc... subclasses: {UnixFileDirectory . AcornFileDirectory . MacFileDirectory . DosFileDirectory...etc... name: #FileDirectory classPool: a Dictionary(#DefaultDirectory->UnixFileDirectory on './stes/s...etc... sharedPools: nil environment: Smalltalk category: #'Files-Directories' [] in HandMorph>>collectDropFilesAndDirectories: Receiver: a HandMorph(1013123) Arguments and temporary variables: < Receiver's instance variables: bounds: 660 at 444 corner: 676 at 460 owner: a PasteUpMorph(2434915) [world] submorphs: #() fullBounds: 660 at 444 corner: 676 at 460 color: Color blue extension: a MorphExtension (1604074) [eventHandler = an EventHandler] [other:...etc... mouseFocus: nil keyboardFocus: a TextMorphForEditView(3274035) eventListeners: nil mouseListeners: nil keyboardListeners: nil eventCaptureFilters: nil mouseCaptureFilters: nil keyboardCaptureFilters: a WeakArray(a HandMorph(1013123)) mouseClickState: nil mouseOverHandler: a MouseOverHandler targetOffset: 68 at 9 lastMouseEvent: [660 at 444 mouseUp ( red ) 111157] damageRecorder: a DamageRecorder cacheCanvas: nil cachedCanvasHasHoles: true temporaryCursor: nil temporaryCursorOffset: nil hardwareCursor: nil hasChanged: true savedPatch: nil userInitials: '' lastEventBuffer: #(1 111157 660 444 0 0 0 1) genieGestureProcessor: nil keyboardInterpreter: an UTF32InputInterpreter externalDropMorph: nil Interval>>collect: Receiver: (1 to: 1) Arguments and temporary variables: aBlock: [closure] in HandMorph>>collectDropFilesAndDirectories: nextValue: 1 result: #(nil) i: 1 iLimiT: 1 Receiver's instance variables: start: 1 stop: 1 step: 1 HandMorph>>collectDropFilesAndDirectories: Receiver: a HandMorph(1013123) Arguments and temporary variables: numFiles: 1 Receiver's instance variables: bounds: 660 at 444 corner: 676 at 460 owner: a PasteUpMorph(2434915) [world] submorphs: #() fullBounds: 660 at 444 corner: 676 at 460 color: Color blue extension: a MorphExtension (1604074) [eventHandler = an EventHandler] [other:...etc... mouseFocus: nil keyboardFocus: a TextMorphForEditView(3274035) eventListeners: nil mouseListeners: nil keyboardListeners: nil eventCaptureFilters: nil mouseCaptureFilters: nil keyboardCaptureFilters: a WeakArray(a HandMorph(1013123)) mouseClickState: nil mouseOverHandler: a MouseOverHandler targetOffset: 68 at 9 lastMouseEvent: [660 at 444 mouseUp ( red ) 111157] damageRecorder: a DamageRecorder cacheCanvas: nil cachedCanvasHasHoles: true temporaryCursor: nil temporaryCursorOffset: nil hardwareCursor: nil hasChanged: true savedPatch: nil userInitials: '' lastEventBuffer: #(1 111157 660 444 0 0 0 1) genieGestureProcessor: nil keyboardInterpreter: an UTF32InputInterpreter externalDropMorph: nil HandMorph>>generateDropFilesEvent: Receiver: a HandMorph(1013123) Arguments and temporary variables: evtBuf: #(3 58791 1 803 1 0 1 1) position: 803 at 1 buttons: 1 modifiers: 0 stamp: 58791 numFiles: 1 dragType: 1 filesAndDirectories: nil oldButtons: nil Receiver's instance variables: bounds: 660 at 444 corner: 676 at 460 owner: a PasteUpMorph(2434915) [world] submorphs: #() fullBounds: 660 at 444 corner: 676 at 460 color: Color blue extension: a MorphExtension (1604074) [eventHandler = an EventHandler] [other:...etc... mouseFocus: nil keyboardFocus: a TextMorphForEditView(3274035) eventListeners: nil mouseListeners: nil keyboardListeners: nil eventCaptureFilters: nil mouseCaptureFilters: nil keyboardCaptureFilters: a WeakArray(a HandMorph(1013123)) mouseClickState: nil mouseOverHandler: a MouseOverHandler targetOffset: 68 at 9 lastMouseEvent: [660 at 444 mouseUp ( red ) 111157] damageRecorder: a DamageRecorder cacheCanvas: nil cachedCanvasHasHoles: true temporaryCursor: nil temporaryCursorOffset: nil hardwareCursor: nil hasChanged: true savedPatch: nil userInitials: '' lastEventBuffer: #(1 111157 660 444 0 0 0 1) genieGestureProcessor: nil keyboardInterpreter: an UTF32InputInterpreter externalDropMorph: nil HandMorph>>processEvents Receiver: a HandMorph(1013123) Arguments and temporary variables: evt: nil evtBuf: #(3 58791 1 803 1 0 1 1) type: 3 hadAny: false Receiver's instance variables: bounds: 660 at 444 corner: 676 at 460 owner: a PasteUpMorph(2434915) [world] submorphs: #() fullBounds: 660 at 444 corner: 676 at 460 color: Color blue extension: a MorphExtension (1604074) [eventHandler = an EventHandler] [other:...etc... mouseFocus: nil keyboardFocus: a TextMorphForEditView(3274035) eventListeners: nil mouseListeners: nil keyboardListeners: nil eventCaptureFilters: nil mouseCaptureFilters: nil keyboardCaptureFilters: a WeakArray(a HandMorph(1013123)) mouseClickState: nil mouseOverHandler: a MouseOverHandler targetOffset: 68 at 9 lastMouseEvent: [660 at 444 mouseUp ( red ) 111157] damageRecorder: a DamageRecorder cacheCanvas: nil cachedCanvasHasHoles: true temporaryCursor: nil temporaryCursorOffset: nil hardwareCursor: nil hasChanged: true savedPatch: nil userInitials: '' lastEventBuffer: #(1 111157 660 444 0 0 0 1) genieGestureProcessor: nil keyboardInterpreter: an UTF32InputInterpreter externalDropMorph: nil [] in WorldState>>doOneCycleNowFor: Receiver: a WorldState Arguments and temporary variables: < Receiver's instance variables: hands: {a HandMorph(1013123)} activeHand: a HandMorph(1013123) viewBox: 0 at 0 corner: 1008 at 680 canvas: a FormCanvas on: DisplayScreen(1008x680x32) damageRecorder: a DamageRecorder stepList: a Heap(StepMessage(#onBlinkCursor -> a TextMorphForEditView(3274035))...etc... lastStepTime: 3775378560621 lastStepMessage: nil lastCycleTime: 3775378560643 commandHistory: a CommandHistory alarms: a MorphicAlarmQueue lastAlarmTime: 3775378560621 remoteServer: nil multiCanvas: nil interCycleDelay: a Delay(20 msecs) Array(SequenceableCollection)>>do: Receiver: {a HandMorph(1013123)} Arguments and temporary variables: aBlock: [closure] in WorldState>>doOneCycleNowFor: index: 1 indexLimiT: 1 Receiver's instance variables: {a HandMorph(1013123)} WorldState>>handsDo: Receiver: a WorldState Arguments and temporary variables: aBlock: [closure] in WorldState>>doOneCycleNowFor: Receiver's instance variables: hands: {a HandMorph(1013123)} activeHand: a HandMorph(1013123) viewBox: 0 at 0 corner: 1008 at 680 canvas: a FormCanvas on: DisplayScreen(1008x680x32) damageRecorder: a DamageRecorder stepList: a Heap(StepMessage(#onBlinkCursor -> a TextMorphForEditView(3274035))...etc... lastStepTime: 3775378560621 lastStepMessage: nil lastCycleTime: 3775378560643 commandHistory: a CommandHistory alarms: a MorphicAlarmQueue lastAlarmTime: 3775378560621 remoteServer: nil multiCanvas: nil interCycleDelay: a Delay(20 msecs) WorldState>>doOneCycleNowFor: Receiver: a WorldState Arguments and temporary variables: aWorld: a PasteUpMorph(2434915) [world] capturingGesture: #(false) Receiver's instance variables: hands: {a HandMorph(1013123)} activeHand: a HandMorph(1013123) viewBox: 0 at 0 corner: 1008 at 680 canvas: a FormCanvas on: DisplayScreen(1008x680x32) damageRecorder: a DamageRecorder stepList: a Heap(StepMessage(#onBlinkCursor -> a TextMorphForEditView(3274035))...etc... lastStepTime: 3775378560621 lastStepMessage: nil lastCycleTime: 3775378560643 commandHistory: a CommandHistory alarms: a MorphicAlarmQueue lastAlarmTime: 3775378560621 remoteServer: nil multiCanvas: nil interCycleDelay: a Delay(20 msecs) WorldState>>doOneCycleFor: Receiver: a WorldState Arguments and temporary variables: aWorld: a PasteUpMorph(2434915) [world] Receiver's instance variables: hands: {a HandMorph(1013123)} activeHand: a HandMorph(1013123) viewBox: 0 at 0 corner: 1008 at 680 canvas: a FormCanvas on: DisplayScreen(1008x680x32) damageRecorder: a DamageRecorder stepList: a Heap(StepMessage(#onBlinkCursor -> a TextMorphForEditView(3274035))...etc... lastStepTime: 3775378560621 lastStepMessage: nil lastCycleTime: 3775378560643 commandHistory: a CommandHistory alarms: a MorphicAlarmQueue lastAlarmTime: 3775378560621 remoteServer: nil multiCanvas: nil interCycleDelay: a Delay(20 msecs) PasteUpMorph>>doOneCycle Receiver: a PasteUpMorph(2434915) [world] Arguments and temporary variables: Receiver's instance variables: bounds: 0 at 0 corner: 1008 at 680 owner: nil submorphs: {a PluggableSystemWindow>spawnNewProcess Receiver: a MorphicProject (HomeProject) in a PasteUpMorph(2434915) [world] Arguments and temporary variables: Receiver's instance variables: dependents: nil world: a PasteUpMorph(2434915) [world] uiManager: a MorphicUIManager changeSet: a ChangeSet named HomeProject transcript: a TranscriptStream parentProject: a MVCProject (RootProject) in a ControlManager previousProject: nil displayDepth: 32 viewSize: 151 at 132 thumbnail: Form(151x132x32) nextProject: nil projectParameters: an IdentityDictionary(#PrevailingProjectFlags->an IdentityDictionary...etc... version: nil urlList: nil lastDirectory: nil lastSavedAtSeconds: nil projectPreferenceFlagDictionary: an IdentityDictionary(#showSharedFlaps->true #showWorldMainDockingBar...etc... resourceManager: a ResourceManager uiProcess: a Process in nil [] in FullBlockClosure(BlockClosure)>>newProcess Receiver: [closure] in MorphicProject>>spawnNewProcess Arguments and temporary variables: Receiver's instance variables: outerContext: MorphicProject>>spawnNewProcess startpcOrMethod: ([] in MorphicProject>>#spawnNewProcess "a CompiledBlock(15491...etc... numArgs: 0 receiver: a MorphicProject (HomeProject) in a PasteUpMorph(2434915) [world] - --- The full stack --- UndefinedObject(Object)>>error: UndefinedObject(Object)>>errorNotIndexable UndefinedObject(Object)>>size FileDirectory class>>on: FileDirectory class>>requestDropDirectory: [] in HandMorph>>collectDropFilesAndDirectories: Interval>>collect: HandMorph>>collectDropFilesAndDirectories: HandMorph>>generateDropFilesEvent: HandMorph>>processEvents [] in WorldState>>doOneCycleNowFor: Array(SequenceableCollection)>>do: WorldState>>handsDo: WorldState>>doOneCycleNowFor: WorldState>>doOneCycleFor: PasteUpMorph>>doOneCycle [] in MorphicProject>>spawnNewProcess [] in FullBlockClosure(BlockClosure)>>newProcess However it's possible that the changeset is using some functionality, that is somehow not working well on Solaris, so perhaps it can be independently tested (unrelated to the changes to the VM or the changeset for dropFile). That's possible ... Is it correct to assume that the problem is somehwere in requestDropDirectory: dropIndex | potentialDirectory | potentialDirectory := self on: (FileStream primDropRequestFileName: dropIndex). ^ potentialDirectory exists ifTrue: [potentialDirectory] The method on: with the FileStream seems to raise an error for me. David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfPmtKAAoJEAwpOKXMq1MaBtMIAKqN0Rb+/q38E9cyj6WI0SdW gGjWhuu1zgs4u/wQQtzDskh3nI57QbN73ytqDPsrX6eRickiYT8MvRQ+ohDqcmfJ HuNwW1esgL9wM1XGhQ5HOVrs+YxheFeqx5ng8rQqMnHGv82PMUh0zBODY3Us6FMg fDq+n0rE2GFMFh7E8PoUR7h84O/wg3oXb3tx5g09ebEo8Ftlz+DCGgnCqg2FNhH+ ORNmqRPTIe6y/eJfWdODpCovOnxld///VO6z1Rc1foyGXo5jDAf2N2vdjAH2CXDe aKXo0RheCV2vM/Jl/lRcYWJh2A/2YvtxbGnb8Dqyz0gQxK2KA6bAg9N4ZyzzX+o= =2iQV -----END PGP SIGNATURE----- -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-677633726 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Thu Aug 20 13:50:20 2020 From: notifications at github.com (Christoph Thiede) Date: Thu, 20 Aug 2020 06:50:20 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: Oh, I just have realized that I forgot to mention that #514 is another dependency of the changeset. Would you mind to merge it as well into your working copy and compiling the VM again? 😅 -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-677676218 -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Thu Aug 20 18:55:31 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 20 Aug 2020 18:55:31 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2792.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2792.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2792 Author: eem Time: 20 August 2020, 11:55:21.739123 am UUID: f914b421-12d3-48b8-b510-833495378c66 Ancestors: VMMaker.oscog-eem.2791 Eliminate translation time type error warnings for extendedStoreBytecodePop: and fetchLong32:ofFloatObject:. Simplify and correct the comments of some of the integer oop => value converison routines. These routines can simply return values directly instead of assigning through a variable. Eliminate unintentional duplication in inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: =============== Diff against VMMaker.oscog-eem.2791 =============== Item was changed: ----- Method: CoInterpreter>>extendedStoreBytecodePop: (in category 'stack bytecodes') ----- extendedStoreBytecodePop: popBoolean "Override to use itemporary:in:put:" + | descriptor variableIndex value | - | descriptor variableType variableIndex value | descriptor := self fetchByte. - variableType := descriptor >> 6 bitAnd: 3. variableIndex := descriptor bitAnd: 63. value := self internalStackTop. + popBoolean ifTrue: [self internalPop: 1]. + (descriptor >> 6 bitAnd: 3) caseOf: { + [0] -> [objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value]. + [1] -> [self itemporary: variableIndex in: localFP put: value]. + [2] -> [self error: 'illegal store']. + [3] -> [self storeLiteralVariable: variableIndex withValue: value] }. + self fetchNextBytecode! - popBoolean ifTrue: [ self internalPop: 1 ]. - variableType = 0 ifTrue: - [objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value. - ^ self fetchNextBytecode.]. - variableType = 1 ifTrue: - [ self fetchNextBytecode. - ^self itemporary: variableIndex in: localFP put: value]. - variableType = 3 ifTrue: - [self storeLiteralVariable: variableIndex withValue: value. - ^ self fetchNextBytecode.]. - self error: 'illegal store'! Item was changed: ----- Method: InterpreterPrimitives>>magnitude64BitValueOf: (in category 'primitive support') ----- magnitude64BitValueOf: oop "Convert the given object into an integer value. + The object may be either a positive SmallInteger or up to an eight-byte LargeInteger." - The object may be either a positive SmallInteger or an eight-byte LargeInteger." - | sz value ok smallIntValue | + | sz ok smallIntValue | - (objectMemory isIntegerObject: oop) ifTrue: [smallIntValue := (objectMemory integerValueOf: oop). + smallIntValue < 0 ifTrue: [smallIntValue := 0 - smallIntValue]. + ^smallIntValue]. - smallIntValue < 0 ifTrue: [smallIntValue := 0 - smallIntValue]. - ^self cCoerce: smallIntValue to: #usqLong]. (objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0]. + ok := objectMemory + isClassOfNonImm: oop + equalTo: (objectMemory splObj: ClassLargePositiveInteger) + compactClassIndex: ClassLargePositiveIntegerCompactIndex. + ok ifFalse: + [ok := objectMemory isClassOfNonImm: oop + equalTo: (objectMemory splObj: ClassLargeNegativeInteger) + compactClassIndex: ClassLargeNegativeIntegerCompactIndex. + ok ifFalse: + [self primitiveFail. + ^0]]. - ok := objectMemory isClassOfNonImm: oop - equalTo: (objectMemory splObj: ClassLargePositiveInteger) - compactClassIndex: ClassLargePositiveIntegerCompactIndex. - ok - ifFalse: - [ok := objectMemory isClassOfNonImm: oop - equalTo: (objectMemory splObj: ClassLargeNegativeInteger) - compactClassIndex: ClassLargeNegativeIntegerCompactIndex. - ok ifFalse: - [self primitiveFail. - ^0]]. sz := objectMemory numBytesOfBytes: oop. sz > (self sizeof: #sqLong) ifTrue: [self primitiveFail. ^0]. + sz > 4 ifTrue: + [^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]. + ^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) + to: #'unsigned int'! - "self cppIf: SPURVM - ifTrue: - [""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes"" - value := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] - ifFalse: - ["sz > 4 - ifTrue: [value := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] - ifFalse: [value := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]". - ^value! Item was changed: ----- Method: InterpreterPrimitives>>maybeInlinePositive32BitValueOf: (in category 'primitive support') ----- maybeInlinePositive32BitValueOf: oop "Convert the given object into an integer value. The object may be either a positive SmallInteger or a four-byte LargePositiveInteger." | value ok sz | (objectMemory isIntegerObject: oop) ifTrue: [value := objectMemory integerValueOf: oop. (value < 0) ifTrue: [self primitiveFail. value := 0]. ^value]. + (objectMemory isNonIntegerImmediate: oop) ifTrue: + [self primitiveFail. + ^0]. + ok := objectMemory + isClassOfNonImm: oop + equalTo: (objectMemory splObj: ClassLargePositiveInteger) + compactClassIndex: ClassLargePositiveIntegerCompactIndex. + ok ifFalse: + [self primitiveFail. + ^0]. + sz := objectMemory numBytesOfBytes: oop. + sz > 4 ifTrue: + [self primitiveFail. + ^0]. + ^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) + to: #'unsigned int'! - (objectMemory isNonIntegerImmediate: oop) - ifTrue: - [self primitiveFail. - ^0] - ifFalse: - [ok := objectMemory - isClassOfNonImm: oop - equalTo: (objectMemory splObj: ClassLargePositiveInteger) - compactClassIndex: ClassLargePositiveIntegerCompactIndex. - ok ifFalse: - [self primitiveFail. - ^0]. - sz := objectMemory numBytesOfBytes: oop. - sz > 4 ifTrue: - [self primitiveFail. - ^0]. - ^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']! Item was changed: ----- Method: InterpreterPrimitives>>positive64BitValueOf: (in category 'primitive support') ----- positive64BitValueOf: oop "Convert the given object into an integer value. + The object may be either a positive SmallInteger or up to an eight-byte LargePositiveInteger." - The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger." + | sz ok smallIntValue | - | sz value ok | - (objectMemory isIntegerObject: oop) ifTrue: + [smallIntValue := objectMemory integerValueOf: oop. + smallIntValue < 0 ifTrue: - [(objectMemory integerValueOf: oop) < 0 ifTrue: [^self primitiveFail]. + ^smallIntValue]. - ^objectMemory integerValueOf: oop]. (objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0]. ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. ok ifFalse: [self primitiveFail. ^0]. sz := objectMemory numBytesOfBytes: oop. sz > (self sizeof: #sqLong) ifTrue: [self primitiveFail. ^0]. + sz > 4 ifTrue: + [^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]. + ^self + cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) + to: #'unsigned int'! - "self cppIf: SPURVM - ifTrue: - [""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes"" - value := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] - ifFalse: - ["sz > 4 - ifTrue: [value := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] - ifFalse: [value := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]". - ^value! Item was changed: ----- Method: InterpreterPrimitives>>positiveMachineIntegerValueOf: (in category 'primitive support') ----- positiveMachineIntegerValueOf: oop "Answer a value of an integer in address range, i.e up to the size of a machine word. The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size." "only two callers & one is primitiveNewWithArg" | value bs ok | (objectMemory isIntegerObject: oop) ifTrue: [value := objectMemory integerValueOf: oop. value < 0 ifTrue: [^self primitiveFail]. ^value]. (objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0]. ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. ok ifFalse: [self primitiveFail. ^0]. bs := objectMemory numBytesOfBytes: oop. bs > (self sizeof: #'usqIntptr_t') ifTrue: [self primitiveFail. ^0]. + ((self sizeof: #'usqIntptr_t') = 8 + and: [bs > 4]) ifTrue: + [^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]. + ^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int'! - "self cppIf: SPURVM - ifTrue: [""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes"" - ^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] - ifFalse: ["((self sizeof: #'usqIntptr_t') = 8 - and: [bs > 4]) - ifTrue: - [^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] - ifFalse: - [^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]"! Item was changed: ----- Method: Spur64BitMemoryManager>>fetchLong32:ofFloatObject: (in category 'object access') ----- fetchLong32: fieldIndex ofFloatObject: oop "index by word size, and return a pointer as long as the word size" + - | bits | (self isImmediateFloat: oop) ifFalse: [^self fetchLong32: fieldIndex ofObject: oop]. bits := self smallFloatBitsOf: oop. ^fieldIndex = 0 ifTrue: [bits bitAnd: 16rFFFFFFFF] ifFalse: [bits >> 32]! Item was changed: ----- Method: SpurMemoryManager>>inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') ----- inLineRunLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid (gcModes anyMask: checkForLeaks) ifTrue: [(gcModes anyMask: GCModeFull) ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7] ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15]. self clearLeakMapAndMapAccessibleObjects. self asserta: (self checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid). self asserta: coInterpreter checkInterpreterIntegrity = 0. - self asserta: coInterpreter checkInterpreterIntegrity = 0. self asserta: coInterpreter checkStackIntegrity. self asserta: (coInterpreter checkCodeIntegrity: gcModes). (gcModes anyMask: GCModeFreeSpace) ifTrue: [self clearLeakMapAndMapAccessibleFreeSpace. self asserta: self checkHeapFreeSpaceIntegrity]]! Item was changed: ----- Method: StackInterpreter>>extendedStoreBytecodePop: (in category 'stack bytecodes') ----- extendedStoreBytecodePop: popBoolean + | descriptor variableIndex value | - | descriptor variableType variableIndex value | descriptor := self fetchByte. - variableType := descriptor >> 6 bitAnd: 3. variableIndex := descriptor bitAnd: 63. value := self internalStackTop. + popBoolean ifTrue: [self internalPop: 1]. + (descriptor >> 6 bitAnd: 3) caseOf: { + [0] -> [objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value]. + [1] -> [self temporary: variableIndex in: localFP put: value]. + [2] -> [self error: 'illegal store']. + [3] -> [self storeLiteralVariable: variableIndex withValue: value] }. + self fetchNextBytecode! - popBoolean ifTrue: [ self internalPop: 1 ]. - variableType = 0 ifTrue: - [objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value. - ^ self fetchNextBytecode]. - variableType = 1 ifTrue: - [ self fetchNextBytecode. - ^self temporary: variableIndex in: localFP put: value]. - variableType = 3 ifTrue: - [self storeLiteralVariable: variableIndex withValue: value. - ^ self fetchNextBytecode]. - self error: 'illegal store' - ! From noreply at github.com Thu Aug 20 19:21:41 2020 From: noreply at github.com (Eliot Miranda) Date: Thu, 20 Aug 2020 12:21:41 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 989bee: CogVM source as per VMMaker.oscog-eem.2792 Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 989bee3ab3d023ebb7b41b7e88da1f8b05f3711c https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/989bee3ab3d023ebb7b41b7e88da1f8b05f3711c Author: Eliot Miranda Date: 2020-08-20 (Thu, 20 Aug 2020) Changed paths: M nsspur64src/vm/cogit.h M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c M spur64src/vm/cogit.h M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cogit.h M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cogit.h M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spurlowcodestack64src/vm/gcc3x-interp.c M spurlowcodestack64src/vm/interp.c M spurlowcodestacksrc/vm/gcc3x-interp.c M spurlowcodestacksrc/vm/interp.c M spursista64src/vm/cogit.h M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstack64src/vm/validImage.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M spurstacksrc/vm/validImage.c M src/vm/cogit.h M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c M stacksrc/vm/gcc3x-interp.c M stacksrc/vm/interp.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.2792 General: Eliminate translation time type error warnings for extendedStoreBytecodePop: and fetchLong32:ofFloatObject:. Simplify and correct the comments of some of the integer oop => value conversion routines. These routines can simply return values directly instead of assigning through a variable. Spur: Looking at class indentityHash distributions in my current VMMaker image it is clear that setting the classTableIndex to point at the start of the last used page is not a good strategy, and leads to far too sparse a class table. So change the policy and set the classTableIndex to the first unused slot. Eliminate unintentional duplication in inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: From builds at travis-ci.org Thu Aug 20 19:44:12 2020 From: builds at travis-ci.org (Travis CI) Date: Thu, 20 Aug 2020 19:44:12 +0000 Subject: [Vm-dev] Errored: OpenSmalltalk/opensmalltalk-vm#2141 (Cog - 989bee3) In-Reply-To: Message-ID: <5f3ed28e369c3_13f9f720e5c44260915@travis-tasks-d56fb877-2m8xg.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2141 Status: Errored Duration: 22 mins and 4 secs Commit: 989bee3 (Cog) Author: Eliot Miranda Message: CogVM source as per VMMaker.oscog-eem.2792 General: Eliminate translation time type error warnings for extendedStoreBytecodePop: and fetchLong32:ofFloatObject:. Simplify and correct the comments of some of the integer oop => value conversion routines. These routines can simply return values directly instead of assigning through a variable. Spur: Looking at class indentityHash distributions in my current VMMaker image it is clear that setting the classTableIndex to point at the start of the last used page is not a good strategy, and leads to far too sparse a class table. So change the policy and set the classTableIndex to the first unused slot. Eliminate unintentional duplication in inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/985c7706236e...989bee3ab3d0 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/719722957?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From no-reply at appveyor.com Thu Aug 20 19:56:06 2020 From: no-reply at appveyor.com (AppVeyor) Date: Thu, 20 Aug 2020 19:56:06 +0000 Subject: [Vm-dev] Build failed: opensmalltalk-vm 1.0.2139 Message-ID: <20200820195606.1.B40A3A1D172ECEBF@appveyor.com> An HTML attachment was scrubbed... URL: From notifications at github.com Fri Aug 21 07:51:34 2020 From: notifications at github.com (David Stes) Date: Fri, 21 Aug 2020 00:51:34 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hello, I've tried building from the "dnd-unify-numfiles" branch. This works for me : I can compile a "squeak-stack-spur" VM from it, and when I drag a file into the Squeak desktop, this works, I don't get into the debugger as I currently have with the sqUnixXdnd branch. However when I try to merge dnd-unify-numfiles into sqUnixXdnd I get Auto-merging platforms/unix/vm-display-X11/sqUnixXdnd.c CONFLICT (content): Merge conflict in platforms/unix/vm-display-X11/sqUnixXdnd.c Automatic merge failed; fix conflicts and then commit the result. So is it please possible that you merge yourself and advise on what change you really want to make to sqUnixXdnd.c ? Also is there documentation on the dropFiles changeset on how to use the new class DemoDropTool, subclass of Model. This would be useful to see how I can test the DemoDropTool. Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfP3zkAAoJEAwpOKXMq1MarjkH/1CVvbshbyyiPh5VeLsCEVAs PcL1JR0YyM/4wzmlIu8PaWyfMICLRh43V1TIXT6gBD1iB/2D30LIdN4Y/20lkJY8 k6W3fqYbQOm5alKw53bq6oobS2brscFThP2mqGJtcObf0NVNBLmmb9lPW++bXUdQ A7KINPCz6kXd/fOcgJMzC9oRXLLJq/wvs2w6MWP69+mBSesIyzAXtgkcde2lbX9G PK+StOk3bjbCSz8TbdlTBE+KQ5FFhigoJIsOOeM7CrSEKWlg0rZIrt+8itLhxdpp 0yro6iPRpjju4uVIBuN/0zxN2K8GlCMUtwT7parnbKI5Jb2kbExX0OXn0E7C33k= =v6j1 -----END PGP SIGNATURE----- -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-678099206 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Fri Aug 21 12:33:26 2020 From: notifications at github.com (Marcel Taeumel) Date: Fri, 21 Aug 2020 05:33:26 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: Merged #508 into Cog. -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#event-3679424816 -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Fri Aug 21 12:33:27 2020 From: noreply at github.com (Marcel Taeumel) Date: Fri, 21 Aug 2020 05:33:27 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 82c7c5: Fix a typo Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 82c7c51183b73fa91c8ee7cd73ded32aaa03b8c4 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/82c7c51183b73fa91c8ee7cd73ded32aaa03b8c4 Author: Christoph Thiede Date: 2020-06-07 (Sun, 07 Jun 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Fix a typo Commit: 97aa3c72a3bf29ef3cd67d23646152c80b5c98fd https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/97aa3c72a3bf29ef3cd67d23646152c80b5c98fd Author: Christoph Thiede Date: 2020-06-12 (Fri, 12 Jun 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Comment out suspicious line Commit: 0b2d16ee5c4efe12b3014afa753d19c9bd64ccfc https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/0b2d16ee5c4efe12b3014afa753d19c9bd64ccfc Author: Christoph Thiede Date: 2020-06-12 (Fri, 12 Jun 2020) Changed paths: M build.win64x64/common/Makefile.msvc M build.win64x64/common/Makefile.msvc.flags Log Message: ----------- Merge branch 'Cog' into sqUnixXdnd Commit: cb852fe26b0fa1e363bf2e62961da6644ea9833b https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/cb852fe26b0fa1e363bf2e62961da6644ea9833b Author: Christoph Thiede Date: 2020-06-12 (Fri, 12 Jun 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Refactor changes Commit: e2be1e85adaa5da536f665cf4a05655c0a0658da https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/e2be1e85adaa5da536f665cf4a05655c0a0658da Author: Christoph Thiede Date: 2020-06-12 (Fri, 12 Jun 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Don't skip SQDragLeave if XGetSelectionOwner failed Commit: aafdc2837074b859c3d392a3f86b3645b12e91d7 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/aafdc2837074b859c3d392a3f86b3645b12e91d7 Author: Christoph Thiede Date: 2020-06-28 (Sun, 28 Jun 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Only record SQDragLeave xor SQDragDrop Commit: 4def9a65347638fe002deb5cfb92d00fa532145c https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/4def9a65347638fe002deb5cfb92d00fa532145c Author: Christoph Thiede Date: 2020-06-28 (Sun, 28 Jun 2020) Changed paths: M .travis.yml M build.macos32x86/common/Makefile.vm R build.macos32x86/common/mkNamedPrims.sh M build.macos64x64/common/Makefile.vm R build.macos64x64/common/mkNamedPrims.sh M nsspur64src/vm/cogit.h M nsspur64src/vm/cogitX64SysV.c M nsspur64src/vm/cogitX64WIN64.c M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cogitARMv5.c M nsspursrc/vm/cogitIA32.c M nsspursrc/vm/cogitMIPSEL.c M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c A platforms/Cross/util/mkIntPluginIndices.sh A platforms/Cross/util/mkNamedPrims.sh M platforms/Cross/vm/sqCogStackAlignment.h M platforms/Cross/vm/sqNamedPrims.c M platforms/iOS/plugins/CameraPlugin/AVFoundationVideoGrabber.m M platforms/win32/misc/Makefile.mingw32 M platforms/win32/plugins/DropPlugin/sqWin32Drop.c M platforms/win32/vm/sqWin32.h M platforms/win32/vm/sqWin32Main.c M platforms/win32/vm/sqWin32PluginSupport.c M platforms/win32/vm/sqWin32Window.c M scripts/revertIfEssentiallyUnchanged M spur64src/vm/cogit.h M spur64src/vm/cogitX64SysV.c M spur64src/vm/cogitX64WIN64.c M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cogit.h M spurlowcode64src/vm/cogitX64SysV.c M spurlowcode64src/vm/cogitX64WIN64.c M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cogit.h M spurlowcodesrc/vm/cogitARMv5.c M spurlowcodesrc/vm/cogitIA32.c M spurlowcodesrc/vm/cogitMIPSEL.c M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spurlowcodestack64src/vm/gcc3x-interp.c M spurlowcodestack64src/vm/interp.c M spurlowcodestacksrc/vm/gcc3x-interp.c M spurlowcodestacksrc/vm/interp.c M spursista64src/vm/cogit.h M spursista64src/vm/cogitX64SysV.c M spursista64src/vm/cogitX64WIN64.c M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cogitARMv5.c M spursistasrc/vm/cogitIA32.c M spursistasrc/vm/cogitMIPSEL.c M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cogitARMv5.c M spursrc/vm/cogitIA32.c M spursrc/vm/cogitMIPSEL.c M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstack64src/vm/validImage.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M spurstacksrc/vm/validImage.c M src/plugins/DESPlugin/DESPlugin.c M src/plugins/DSAPrims/DSAPrims.c M src/plugins/MD5Plugin/MD5Plugin.c M src/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c A src/plugins/SHA2Plugin/SHA2Plugin.c M src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c M src/plugins/SqueakFFIPrims/ARM64FFIPlugin.c M src/plugins/SqueakFFIPrims/IA32FFIPlugin.c M src/plugins/SqueakFFIPrims/X64SysVFFIPlugin.c M src/plugins/SqueakFFIPrims/X64Win64FFIPlugin.c M src/vm/cogit.h M src/vm/cogitARMv5.c M src/vm/cogitIA32.c M src/vm/cogitMIPSEL.c M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c M stacksrc/vm/gcc3x-interp.c M stacksrc/vm/interp.c M third-party/libssh2.spec Log Message: ----------- Merge remote-tracking branch 'origin/Cog' into sqUnixXdnd Commit: 1fde7270c5c3c4bbf7e9d33b8594f9e3ac3f8c92 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/1fde7270c5c3c4bbf7e9d33b8594f9e3ac3f8c92 Author: Christoph Thiede Date: 2020-07-10 (Fri, 10 Jul 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Add explaining comments Commit: 33df20b6b4e18c5b827bd3da48be3ba0e1a1dcef https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/33df20b6b4e18c5b827bd3da48be3ba0e1a1dcef Author: Christoph Thiede Date: 2020-07-10 (Fri, 10 Jul 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Refactor drop event generation In particular, if the dropped content cannot be accepted, record a DragDrop event with numFiles == 0 rather than a DragLeave event. This aligns the behavior to the handling of unsupported drag contents such as texts. Commit: 3100c64c6b770079bdd13888ed8740eff38a8fe7 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/3100c64c6b770079bdd13888ed8740eff38a8fe7 Author: Christoph Thiede Date: 2020-07-10 (Fri, 10 Jul 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Improve comments Commit: 2ff21e28c04f97b3250e8001a6befc33e21ca2b7 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2ff21e28c04f97b3250e8001a6befc33e21ca2b7 Author: Christoph Thiede Date: 2020-07-10 (Fri, 10 Jul 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Nuke obsolete variable Commit: b992e979b0ddc8f0887e965f411d0a6ca5108282 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/b992e979b0ddc8f0887e965f411d0a6ca5108282 Author: Christoph Thiede Date: 2020-07-10 (Fri, 10 Jul 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Revert rejected change Commit: 403836b5d07d6036e2855d133d148df9e4602892 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/403836b5d07d6036e2855d133d148df9e4602892 Author: Christoph Thiede Date: 2020-07-10 (Fri, 10 Jul 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Fix a stupid slip Commit: b45c7b1d8d8a99f24adf13785a3cbae783ad2d46 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/b45c7b1d8d8a99f24adf13785a3cbae783ad2d46 Author: Christoph Thiede Date: 2020-08-19 (Wed, 19 Aug 2020) Changed paths: M .gitignore M build.linux32ARMv6/squeak.cog.spur/plugins.ext M build.linux32ARMv6/squeak.stack.spur/plugins.ext M build.linux32ARMv6/squeak.stack.v3/plugins.ext M build.linux32x86/squeak.cog.spur.immutability/plugins.ext M build.linux32x86/squeak.cog.spur/plugins.ext M build.linux32x86/squeak.cog.v3/plugins.ext M build.linux32x86/squeak.sista.spur/plugins.ext M build.linux32x86/squeak.stack.spur/plugins.ext M build.linux32x86/squeak.stack.v3/plugins.ext A build.linux64ARMv8/HowToBuild A build.linux64ARMv8/makeall A build.linux64ARMv8/makeallclean A build.linux64ARMv8/makeallmakefiles A build.linux64ARMv8/makeallsqueak R build.linux64ARMv8/pharo.cog.spur/apt-get-libs.sh R build.linux64ARMv8/pharo.cog.spur/build/mvm R build.linux64ARMv8/pharo.cog.spur/plugins.ext R build.linux64ARMv8/pharo.cog.spur/plugins.ext.all R build.linux64ARMv8/pharo.cog.spur/plugins.int M build.linux64ARMv8/pharo.stack.spur/build.debug/mvm M build.linux64ARMv8/squeak.cog.spur/build.assert/mvm M build.linux64ARMv8/squeak.cog.spur/build.debug/mvm M build.linux64ARMv8/squeak.cog.spur/build/mvm M build.linux64ARMv8/squeak.cog.spur/plugins.ext M build.linux64ARMv8/squeak.stack.spur/build.assert/mvm M build.linux64ARMv8/squeak.stack.spur/plugins.ext M build.linux64x64/makeallsqueak M build.linux64x64/squeak.cog.spur.immutability/plugins.ext M build.linux64x64/squeak.cog.spur/plugins.ext M build.linux64x64/squeak.stack.spur/plugins.ext M build.macos32x86/common/Makefile.app M build.macos32x86/common/Makefile.flags M build.macos32x86/common/Makefile.lib.extra M build.macos32x86/common/Makefile.plugin M build.macos32x86/common/Makefile.rules M build.macos32x86/common/Makefile.vm M build.macos32x86/makeproduct M build.macos32x86/squeak.cog.spur+immutability/plugins.ext M build.macos32x86/squeak.cog.spur/plugins.ext M build.macos32x86/squeak.cog.v3/plugins.ext M build.macos32x86/squeak.sista.spur/plugins.ext M build.macos32x86/squeak.stack.spur/plugins.ext M build.macos32x86/squeak.stack.v3/plugins.ext A build.macos64ARMv8/HowToBuild A build.macos64ARMv8/bochsx64/conf.COG A build.macos64ARMv8/bochsx64/conf.COG.dbg A build.macos64ARMv8/bochsx64/exploration/Makefile A build.macos64ARMv8/bochsx64/makeclean A build.macos64ARMv8/bochsx64/makeem A build.macos64ARMv8/bochsx86/conf.COG A build.macos64ARMv8/bochsx86/conf.COG.dbg A build.macos64ARMv8/bochsx86/exploration/Makefile A build.macos64ARMv8/bochsx86/makeclean A build.macos64ARMv8/bochsx86/makeem A build.macos64ARMv8/common/Makefile.app A build.macos64ARMv8/common/Makefile.app.newspeak A build.macos64ARMv8/common/Makefile.app.squeak A build.macos64ARMv8/common/Makefile.flags A build.macos64ARMv8/common/Makefile.lib.extra A build.macos64ARMv8/common/Makefile.plugin A build.macos64ARMv8/common/Makefile.rules A build.macos64ARMv8/common/Makefile.sources A build.macos64ARMv8/common/Makefile.vm A build.macos64ARMv8/gdbarm32/clean A build.macos64ARMv8/gdbarm32/conf.COG A build.macos64ARMv8/gdbarm32/makeem A build.macos64ARMv8/gdbarm64/clean A build.macos64ARMv8/gdbarm64/conf.COG A build.macos64ARMv8/gdbarm64/makeem A build.macos64ARMv8/makeall A build.macos64ARMv8/makeallinstall A build.macos64ARMv8/makeproduct A build.macos64ARMv8/makeproductinstall A build.macos64ARMv8/makesista A build.macos64ARMv8/makespur A build.macos64ARMv8/pharo.stack.spur.lowcode/Makefile A build.macos64ARMv8/pharo.stack.spur.lowcode/mvm A build.macos64ARMv8/pharo.stack.spur.lowcode/plugins.ext A build.macos64ARMv8/pharo.stack.spur.lowcode/plugins.int A build.macos64ARMv8/pharo.stack.spur/Makefile A build.macos64ARMv8/pharo.stack.spur/mvm A build.macos64ARMv8/pharo.stack.spur/plugins.ext A build.macos64ARMv8/pharo.stack.spur/plugins.int A build.macos64ARMv8/squeak.cog.spur.immutability/Makefile A build.macos64ARMv8/squeak.cog.spur.immutability/mvm A build.macos64ARMv8/squeak.cog.spur.immutability/plugins.ext A build.macos64ARMv8/squeak.cog.spur.immutability/plugins.int A build.macos64ARMv8/squeak.cog.spur/Makefile A build.macos64ARMv8/squeak.cog.spur/mvm A build.macos64ARMv8/squeak.cog.spur/plugins.ext A build.macos64ARMv8/squeak.cog.spur/plugins.int A build.macos64ARMv8/squeak.sista.spur/Makefile A build.macos64ARMv8/squeak.sista.spur/mvm A build.macos64ARMv8/squeak.sista.spur/plugins.ext A build.macos64ARMv8/squeak.sista.spur/plugins.int A build.macos64ARMv8/squeak.stack.spur/Makefile A build.macos64ARMv8/squeak.stack.spur/mvm A build.macos64ARMv8/squeak.stack.spur/plugins.ext A build.macos64ARMv8/squeak.stack.spur/plugins.int M build.macos64x64/common/Makefile.app M build.macos64x64/common/Makefile.flags M build.macos64x64/common/Makefile.lib.extra M build.macos64x64/common/Makefile.plugin M build.macos64x64/common/Makefile.rules M build.macos64x64/common/Makefile.vm M build.macos64x64/squeak.cog.spur.immutability/plugins.ext M build.macos64x64/squeak.cog.spur/plugins.ext M build.macos64x64/squeak.sista.spur/plugins.ext M build.macos64x64/squeak.stack.spur/plugins.ext M build.sunos32x86/squeak.cog.spur/plugins.ext M build.sunos32x86/squeak.stack.spur/plugins.ext M build.sunos64x64/squeak.cog.spur/plugins.ext M build.sunos64x64/squeak.stack.spur/plugins.ext M build.win32x86/squeak.cog.spur.lowcode/plugins.ext M build.win32x86/squeak.cog.spur/plugins.ext M build.win32x86/squeak.cog.v3/plugins.ext M build.win32x86/squeak.sista.spur/plugins.ext M build.win32x86/squeak.stack.spur/plugins.ext M build.win32x86/squeak.stack.v3/plugins.ext M build.win64x64/squeak.cog.spur/plugins.ext M build.win64x64/squeak.stack.spur/plugins.ext M nsspur64src/vm/cogit.h A nsspur64src/vm/cogitARMv8.c M nsspur64src/vm/cogitX64SysV.c M nsspur64src/vm/cogitX64WIN64.c M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cogitARMv5.c M nsspursrc/vm/cogitIA32.c M nsspursrc/vm/cogitMIPSEL.c M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c M platforms/Cross/plugins/FloatMathPlugin/ieee754names.h M platforms/Cross/plugins/IA32ABI/arm32abicc.c M platforms/Cross/plugins/IA32ABI/arm64abicc.c M platforms/Cross/plugins/IA32ABI/dabusiness.h M platforms/Cross/plugins/IA32ABI/dabusinessARM.h M platforms/Cross/plugins/IA32ABI/dabusinessARM32.h M platforms/Cross/plugins/IA32ABI/dabusinessARM64.h M platforms/Cross/plugins/IA32ABI/dabusinessPostLogic.h M platforms/Cross/plugins/IA32ABI/dabusinessppc.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicDouble.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicFloat.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicInteger.h M platforms/Cross/plugins/IA32ABI/ia32abicc.c M platforms/Cross/plugins/IA32ABI/ppc32abicc.c M platforms/Cross/plugins/IA32ABI/x64sysvabicc.c M platforms/Cross/plugins/IA32ABI/x64win64abicc.c M platforms/Cross/third-party/fdlibm/fdlibm.h M platforms/Cross/vm/sq.h M platforms/Cross/vm/sqAssert.h M platforms/Cross/vm/sqTicker.c M platforms/Mac OS/vm/sqMacMain.c M platforms/iOS/plugins/BochsIA32Plugin/Makefile M platforms/iOS/plugins/BochsX64Plugin/Makefile M platforms/iOS/plugins/CameraPlugin/AVFoundationVideoGrabber.m M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.h M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.m M platforms/iOS/vm/Common/Classes/sqSqueakMainApp.m M platforms/iOS/vm/OSX/sqMacUnixExternalPrims.m M platforms/iOS/vm/OSX/sqSqueakOSXApplication+attributes.m M platforms/iOS/vm/OSX/sqSqueakOSXScreenAndWindow.m M platforms/iOS/vm/iPhone/Classes/sqSqueakIPhoneApplication+attributes.m M platforms/iOS/vm/iPhone/Classes/sqSqueakIPhoneApplication.m M platforms/minheadless/generic/sqPlatformSpecific-Generic.c M platforms/minheadless/unix/sqPlatformSpecific-Unix.c M platforms/minheadless/windows/sqPlatformSpecific-Win32.c M platforms/unix/vm/include_ucontext.h M platforms/unix/vm/sqUnixMain.c M platforms/win32/vm/sqWin32VMProfile.c M spur64src/vm/cogit.h A spur64src/vm/cogitARMv8.c M spur64src/vm/cogitX64SysV.c M spur64src/vm/cogitX64WIN64.c M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cogit.h A spurlowcode64src/vm/cogitARMv8.c M spurlowcode64src/vm/cogitX64SysV.c M spurlowcode64src/vm/cogitX64WIN64.c M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cogit.h M spurlowcodesrc/vm/cogitARMv5.c M spurlowcodesrc/vm/cogitIA32.c M spurlowcodesrc/vm/cogitMIPSEL.c M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spurlowcodestack64src/vm/gcc3x-interp.c M spurlowcodestack64src/vm/interp.c M spurlowcodestacksrc/vm/gcc3x-interp.c M spurlowcodestacksrc/vm/interp.c M spursista64src/vm/cogit.h A spursista64src/vm/cogitARMv8.c M spursista64src/vm/cogitX64SysV.c M spursista64src/vm/cogitX64WIN64.c M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cogitARMv5.c M spursistasrc/vm/cogitIA32.c M spursistasrc/vm/cogitMIPSEL.c M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cogitARMv5.c M spursrc/vm/cogitIA32.c M spursrc/vm/cogitMIPSEL.c M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstack64src/vm/validImage.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M spurstacksrc/vm/validImage.c A src/ckformat.c M src/plugins/B3DAcceleratorPlugin/B3DAcceleratorPlugin.c M src/plugins/BitBltPlugin/BitBltPlugin.c M src/plugins/FileAttributesPlugin/FileAttributesPlugin.c M src/plugins/FilePlugin/FilePlugin.c M src/plugins/IA32ABI/IA32ABI.c M src/plugins/JPEGReadWriter2Plugin/JPEGReadWriter2Plugin.c M src/plugins/LargeIntegers/LargeIntegers.c M src/plugins/MacMenubarPlugin/MacMenubarPlugin.c M src/plugins/Matrix2x3Plugin/Matrix2x3Plugin.c M src/plugins/SecurityPlugin/SecurityPlugin.c M src/plugins/SocketPlugin/SocketPlugin.c M src/plugins/SoundPlugin/SoundPlugin.c M src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c M src/plugins/SqueakFFIPrims/ARM64FFIPlugin.c M src/plugins/SqueakFFIPrims/IA32FFIPlugin.c M src/plugins/SqueakFFIPrims/X64SysVFFIPlugin.c M src/plugins/SqueakFFIPrims/X64Win64FFIPlugin.c M src/plugins/UnixOSProcessPlugin/UnixOSProcessPlugin.c M src/plugins/VMProfileLinuxSupportPlugin/VMProfileLinuxSupportPlugin.c M src/plugins/VMProfileMacSupportPlugin/VMProfileMacSupportPlugin.c M src/plugins/XDisplayControlPlugin/XDisplayControlPlugin.c M src/vm/cogit.h M src/vm/cogitARMv5.c M src/vm/cogitIA32.c M src/vm/cogitMIPSEL.c M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c M stacksrc/vm/gcc3x-interp.c M stacksrc/vm/interp.c Log Message: ----------- Merge branch 'Cog' into sqUnixXdnd Commit: a9b022f578fdb61119663da6931293513ec3e6a4 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/a9b022f578fdb61119663da6931293513ec3e6a4 Author: Marcel Taeumel Date: 2020-08-21 (Fri, 21 Aug 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Merge pull request #508 from LinqLover/sqUnixXdnd sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/989bee3ab3d0...a9b022f578fd From builds at travis-ci.org Fri Aug 21 12:56:05 2020 From: builds at travis-ci.org (Travis CI) Date: Fri, 21 Aug 2020 12:56:05 +0000 Subject: [Vm-dev] Errored: OpenSmalltalk/opensmalltalk-vm#2142 (Cog - a9b022f) In-Reply-To: Message-ID: <5f3fc46459d52_13ff2e1fc75386026@travis-tasks-d75c9f844-9rp6k.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2142 Status: Errored Duration: 22 mins and 2 secs Commit: a9b022f (Cog) Author: Marcel Taeumel Message: Merge pull request #508 from LinqLover/sqUnixXdnd sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/989bee3ab3d0...a9b022f578fd View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/719915782?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From no-reply at appveyor.com Fri Aug 21 15:10:19 2020 From: no-reply at appveyor.com (AppVeyor) Date: Fri, 21 Aug 2020 15:10:19 +0000 Subject: [Vm-dev] Build completed: opensmalltalk-vm 1.0.2140 Message-ID: <20200821151019.1.5DD8FBEB4356865B@appveyor.com> An HTML attachment was scrubbed... URL: From notifications at github.com Fri Aug 21 18:00:37 2020 From: notifications at github.com (Christoph Thiede) Date: Fri, 21 Aug 2020 11:00:37 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: @LinqLover pushed 1 commit. dae0bf5670efa757c482ada192534244efe2d688 Merge branch 'Cog' into dnd-unify-numfiles -- You are receiving this because you are subscribed to this thread. View it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514/files/a749b6b54909d6f3eea544fdffe17271d00a7f95..dae0bf5670efa757c482ada192534244efe2d688 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Fri Aug 21 18:08:41 2020 From: notifications at github.com (Christoph Thiede) Date: Fri, 21 Aug 2020 11:08:41 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] sqUnixXdnd: Don't record SQDragLeave when XdndDrop is handled (#508) In-Reply-To: References: Message-ID: @cstes Sorry for the delay, Marcel was so kind to merge this by now. I resolved the conflict in #514. Feel free to compile again based on #514 and tell me whether it works for you :-) -- You are receiving this because you commented. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/508#issuecomment-678420198 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Fri Aug 21 19:43:31 2020 From: notifications at github.com (Christoph Thiede) Date: Fri, 21 Aug 2020 12:43:31 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: > So is it please possible that you merge yourself Done > Also is there documentation on the dropFiles changeset on how to use the new class DemoDropTool, subclass of Model. Good hint! Just do `ToolBuilder open. DemoDropTool` and then try to drop things into the tool. It's really only a demo made to show the different drop hooks we have got. -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-678460513 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sat Aug 22 08:39:50 2020 From: notifications at github.com (David Stes) Date: Sat, 22 Aug 2020 01:39:50 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I compiled a new VM from the updated branch: # squeak -version # 5.0-202008211759-dnd-unify-numfiles Sat Aug 22 09:57:02 CEST 2020 cc [Production Spur 64-bit VM] # StackInterpreter VMMaker.oscog-eem.2792 uuid: f914b421-12d3-48b8-b510-833495378c66 Aug 22 2020 # VM: 202008211759-dnd-unify-numfiles stes at gecko:src/thiede/opensmalltalk # Date: Fri Aug 21 19:59:53 2020 CommitHash: dae0bf567 # Plugins: 202008211759-dnd-unify-numfiles stes at gecko:src/thiede/opensmalltalk Then I used the image Squeak6.0alpha-19687-64bit.image. I loaded (with Tools -> File List "FileIn") the changeset DropFiles3.14.cs (and DropFiles-examples.cs). When I drag and drop 2 files myfile1 and myfile2 into the Squeak desktop, it works, I get "PluggableSystemWindow" objects without getting into the debugger. If I then (following your previous instructions) browse HandMorph, and go to private events #generateDropFilesEvent: and insert the showln: and when I then drag again the files, it works (without debugger), and the Transcript shows: 1 2 ... 2 2 4 So that seems to work. Can you explain more how to use the DemoDropTool ? How to open the ToolBuilder and get from there to the DemoDropTool ... Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfQNVuAAoJEAwpOKXMq1Mal6YIAKVbbsAyJWhW6jZF2MTZ4vCV CB7R9mZBmRbSCcF6QD5bUfzq5CXBsnEaQWuswdupdfyEzlUK1l/3vmQUhIiRHFYN i5X9YQdwb5wvbuHMr346zRQoRACMPlWOQnUTXJn42TGHmKKrSa1ug+wZEVcmb3Bo Z1KheFmCERjkbv4lcb8KERKG5RfdoZyy+MIQnEoBVLNIyx3CVIRlGXVKXet1s47/ yi0g/B2MKBnhYEopDXAGJrio4+KadnNrKxQVhgBsJJxIdgciFOnCFHXfkEPEE0hi NtlEuQalotcl2MhQjobMbRmZwgyLtOKqrkysPoTxULN1/CL4fWfjX29DR2rx1mM= =JKWg -----END PGP SIGNATURE----- -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-678614247 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sat Aug 22 08:39:50 2020 From: notifications at github.com (David Stes) Date: Sat, 22 Aug 2020 01:39:50 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, I compiled a new VM from the updated branch: # squeak -version # 5.0-202008211759-dnd-unify-numfiles Sat Aug 22 09:57:02 CEST 2020 cc [Production Spur 64-bit VM] # StackInterpreter VMMaker.oscog-eem.2792 uuid: f914b421-12d3-48b8-b510-833495378c66 Aug 22 2020 # VM: 202008211759-dnd-unify-numfiles stes at gecko:src/thiede/opensmalltalk # Date: Fri Aug 21 19:59:53 2020 CommitHash: dae0bf567 # Plugins: 202008211759-dnd-unify-numfiles stes at gecko:src/thiede/opensmalltalk Then I used the image Squeak6.0alpha-19687-64bit.image. I loaded (with Tools -> File List "FileIn") the changeset DropFiles3.14.cs (and DropFiles-examples.cs). When I drag and drop 2 files myfile1 and myfile2 into the Squeak desktop, it works, I get "PluggableSystemWindow" objects without getting into the debugger. If I then (following your previous instructions) browse HandMorph, and go to private events #generateDropFilesEvent: and insert the showln: and when I then drag again the files, it works (without debugger), and the Transcript shows: 1 2 ... 2 2 4 So that seems to work. Can you explain more how to use the DemoDropTool ? How to open the ToolBuilder and get from there to the DemoDropTool ... Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfQNVuAAoJEAwpOKXMq1Mal6YIAKVbbsAyJWhW6jZF2MTZ4vCV CB7R9mZBmRbSCcF6QD5bUfzq5CXBsnEaQWuswdupdfyEzlUK1l/3vmQUhIiRHFYN i5X9YQdwb5wvbuHMr346zRQoRACMPlWOQnUTXJn42TGHmKKrSa1ug+wZEVcmb3Bo Z1KheFmCERjkbv4lcb8KERKG5RfdoZyy+MIQnEoBVLNIyx3CVIRlGXVKXet1s47/ yi0g/B2MKBnhYEopDXAGJrio4+KadnNrKxQVhgBsJJxIdgciFOnCFHXfkEPEE0hi NtlEuQalotcl2MhQjobMbRmZwgyLtOKqrkysPoTxULN1/CL4fWfjX29DR2rx1mM= =JKWg -----END PGP SIGNATURE----- -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-678614248 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sat Aug 22 12:17:57 2020 From: notifications at github.com (Christoph Thiede) Date: Sat, 22 Aug 2020 05:17:57 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: > Can you explain more how to use the DemoDropTool ? > How to open the ToolBuilder and get from there to the DemoDropTool ... The ToolBuilder is not a tool but a class that can build tools for you. The correct snippet is: ```smalltalk ToolBuilder open: DemoDropTool. ``` Insert this into any text field and press d to do it. -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-678633557 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sat Aug 22 16:00:31 2020 From: notifications at github.com (David Stes) Date: Sat, 22 Aug 2020 09:00:31 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hi, This results in a doesNotUnderstand: message for DemoDropTool, it does not recognize the #buildListWith: selector. Does it work for you ? I get - --- The full stack --- DemoDropTool(Object)>>doesNotUnderstand: #buildListWith: [] in DemoDropTool>>buildWith: [] in DemoDropTool(Model)>>buildWindowWith:specs: Array(SequenceableCollection)>>do: DemoDropTool(Model)>>buildWindowWith:specs: DemoDropTool>>buildWith: DemoDropTool class(Model class)>>buildWith: MorphicToolBuilder(ToolBuilder)>>build: MorphicToolBuilder>>open: ToolBuilder class>>open: David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfQUCzAAoJEAwpOKXMq1Ma68cH/RmTsvmtMaSpoGXaddKM/Ez9 WLqsGE3FQZboHGJ+D9wV6mDB/wIfH9r8pqv93VeHHPeX5g2M76MAF/2KlUzey6KL RkKvxtAOtVxyWyzL2CdSQnwjIcRmuzLnkg05x2HODbWEuHWmib7yzH9+XZhBfbDm 67qaiDC+MXnP2ETlJ5G0zgMkAbByYdiIN1iPLv//dKz/Vxj6ZE/fFK7HUupm2tDa NszB5Y8r1fdZsvSzzYbin0878h9DJoqwWiVKaRgfx3+4CSr0hUDZL9yss5OTJA6C QbSfD6Nxo5i4jdPF/EIWvV4ORnvlrKkEx5CLLgMHAMcypJxN1RG/ekCRu6uOQns= =uAio -----END PGP SIGNATURE----- -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-678657975 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sat Aug 22 18:25:34 2020 From: notifications at github.com (Christoph Thiede) Date: Sat, 22 Aug 2020 11:25:34 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: Oh, so sorry, I have no idea how this method has flown off my changeset. :-( If you still have patience, you could try this one: [dropFiles3.31.zip](https://github.com/OpenSmalltalk/opensmalltalk-vm/files/5112779/dropFiles3.31.zip) -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-678675122 -------------- next part -------------- An HTML attachment was scrubbed... URL: From ken.dickey at whidbey.com Sat Aug 22 21:41:55 2020 From: ken.dickey at whidbey.com (ken.dickey at whidbey.com) Date: Sat, 22 Aug 2020 14:41:55 -0700 Subject: [Vm-dev] Embedded Squeak/Cuis Message-ID: <55b5871995ba4725804ab59f42411e23@whidbey.com> The saying goes - once is happenstance - twice is just circumstance - the third time and you have discovered a Natural Law So what does this have to do with anything? Well, I now have a revitalized vm-display-fbdev working on Raspberry Pi 3 -- Alpine Linux Raspberry Pi 4 -- Alpine Linux and LePotato (AML-s905x-cc) -- Armbian (Debian) Linux Which run Squeak and Cuis images. Uses libevdev and a framebuffer. Works with libc or MUSL. No X11! Look, ma! Smalltalk IS the window system! Having done it is a proof of concept. ;^) https://github.com/KenDickey/opensmalltalk-vm or just the salients in https://github.com/KenDickey/FBDevVM See some notes in the top-level directories and look at 'build.linux68ARMv8/HowToBuild'. Any help in Sqeakifying/cleaning the sources is appreciated. I only use Arm chips. Any brave souls want to test using amd64/intel? Enjoy! -KenD From notifications at github.com Sun Aug 23 03:09:17 2020 From: notifications at github.com (Ken Dickey) Date: Sat, 22 Aug 2020 20:09:17 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) Message-ID: Note: mvm needs TLC for framebuffer builds. Armbian does not use MUSL, but -DMUSL was harmless. ToDo: mouse wheel events not yet converted to arrow codes. Armbian-Notes.txt and AlpineLinux-Notes.txt need to be migrated or merged into HowToBuild You can view, comment on, or merge this pull request online at: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515 -- Commit Summary -- * just a start * adding Evdev * evdev * much unparsed code * mumble * simplify * commentary * a bit closer (unparsed) * parses;untested * basic evdev mouse & keyboard * build flags - stdoutStack * display looks good * cursor tracks now; no kbd * still lacking mouse button events * because white pixels are boring * latest trial * mouse buttons seen * basics work * keymap fixups * elided X11 cruft * static fbSelf * useful * dup * added openssl-dev to apk * hdmi boot config * cruft removal * shell vars * cursor looks OK now * platform independent sizes (16ok|32no) * 32bit fb depth OK * reboot lossage fixup * 32 bit depth works * cmd-. works * shorted splash screen display time * new -- File Changes -- A AlpineLinux-Notes.txt (80) A Armbian-Notes.txt (21) A build.linux64ARMv8/HowToBuild (352) M build.linux64ARMv8/squeak.cog.spur/build/mvm (7) M build.linux64ARMv8/squeak.stack.spur/build.debug/mvm (7) M build.linux64ARMv8/squeak.stack.spur/build/mvm (8) M platforms/Cross/vm/sqVirtualMachine.c (4) M platforms/unix/vm-display-fbdev/00_README.fbdev (9) A platforms/unix/vm-display-fbdev/Balloon.h (2644) A platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c (660) A platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c (620) M platforms/unix/vm-display-fbdev/sqUnixFBDev.c (27) M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c (176) M platforms/unix/vm/debug.h (2) M platforms/unix/vm/sqUnixMain.c (5) -- Patch Links -- https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515.patch https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515.diff -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sun Aug 23 03:11:24 2020 From: notifications at github.com (Ken Dickey) Date: Sat, 22 Aug 2020 20:11:24 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) In-Reply-To: References: Message-ID: HowToBuild should be just a duplicate. Shoule be ignorable.. -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515#issuecomment-678723181 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sun Aug 23 03:13:19 2020 From: notifications at github.com (Ken Dickey) Date: Sat, 22 Aug 2020 20:13:19 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) In-Reply-To: References: Message-ID: ignore the duplicate -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515#issuecomment-678723316 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sun Aug 23 08:20:25 2020 From: notifications at github.com (David Stes) Date: Sun, 23 Aug 2020 01:20:25 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 This new package dropFiles is working: ToolBuilder open:DemoDropTool works, it displays some numbers (1 ... 10) although I'm not sure how to use it. In any case the VM with dnd-unify-numfiles seems to be working. David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfQiYvAAoJEAwpOKXMq1Ma8fkH/2kuQkoWRehBEpttp3/VNM9c 4QoYMRhRAHRlr/flGMZgNpWSGtEOZIrZdSAz8+Y0YBKEz6s7vV3sX46/mxb2TNP0 k6RZ5oNL/bWhoCAteEzIK0WXWRWWTpZLai6nScntc5kg5u2uvrH6m2VzjRJaKp3b qGX7//OeF/3gVWX+l9PNf+oPM7jMui/KlAE+XIfN+9BwaTsGDRgMV4HMS9vsyMcz dYYAUmd5tyfOKVHPXuqcFvihqmx6xP5m/9ptP4nx6vyf9ck4Xj28rCbj97JucaNm 0dQoUO0Z8Vnbct7OcAmzhLAPS2yQ08EAiRLf1BDrNZlAtDY2R53HKzgbGz1Uvw4= =Emqj -----END PGP SIGNATURE----- -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-678744946 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Mon Aug 24 10:57:53 2020 From: notifications at github.com (Christoph Thiede) Date: Mon, 24 Aug 2020 03:57:53 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] DropPlugin: Unify numFiles fallback value before DragDrop has been recorded (#514) In-Reply-To: References: Message-ID: You can use the DemoDropTool by dragging objects into each of the three panes, and to show that the drop works, it displays each dragged items. For example, try to drag a text to number 5 of the list and the 5 will be replaced by the text. Together with this PR, you can drag a file from the host system directly in this tool. -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/514#issuecomment-679058647 -------------- next part -------------- An HTML attachment was scrubbed... URL: From craig at blackpagedigital.com Mon Aug 24 20:42:10 2020 From: craig at blackpagedigital.com (Craig Latta) Date: Mon, 24 Aug 2020 13:42:10 -0700 Subject: [Vm-dev] Fwd: [WebAssembly/gc] Requirements (#121) In-Reply-To: References: Message-ID: Hi-- If you're interested in implementing OpenSmalltalk/Cog/Spur on WebAssembly, this would be a good time to get involved in the WASM garbage collection design discussion. It's getting more concrete, and has the attention of all the major committed participants. -C *** -------- Forwarded Message -------- Subject: Re: [WebAssembly/gc] Requirements (#121) Date: Mon, 24 Aug 2020 13:18:23 -0700 From: Thomas Lively To: WebAssembly/gc *@tlively* commented on this pull request. Personally, I've been assuming that we are designing to optimize peak performance for optimizing engines that will not do dynamic feedback collection. I agree that it would be helpful to check for consensus on what design constraints we are assuming for the top-tier of engines we are designing for. ------------------------------------------------------------------------ In Requirements.md : > +1. Performance is more important than convenience. + + Since WASM-GC is not intended as a user-facing technology, convenience here refers to the ease with which toolchain authors can target WASM-GC. + + Convenience for toolchain authors is still important however, as that affects adoption of WASM-GC. + + +## Critical Success Factors + +A critical success factor is an aspect or property of possible solutions that may or may not be directly focused on the primary objective, but none-the-less is estimated to be crucially important to the success of the effort. + +1. Permit ‘cycle detection’ between host structures and language structures; so that such cycles can be collected if there are no other references to them. + + When a WASM-GC module accesses host capabilities, or when a host application access structures from a WASM-GC library, cross references between them are likely to be established. For example, a DOM node may have an event listener that is actually implemented in WASM. The event listener, in turn, may have a reference to the DOM node it is listening to. This represents a cycle between the host and WASM-GC. If there are no other references to this cycles (if, for example, the DOM node is removed) then the entire cycle must be able to be collected. + +1. Performance implications of WASM-GC code should be straightforward. *** -- Craig Latta Black Page Digital Berkeley, California blackpagedigital.com From commits at source.squeak.org Tue Aug 25 02:48:02 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 25 Aug 2020 02:48:02 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2793.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2793.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2793 Author: eem Time: 24 August 2020, 7:47:53.984785 pm UUID: 87cb649c-1079-4e58-9e4c-cbf9d4f6669d Ancestors: VMMaker.oscog-eem.2792 SmartSyntaxPlugins: methodReturnFoo's are too useful an ideom not to support properly. Ensure that SmartSyntaxPluginCodeGenerator is smart enough not to require the use of an explicit return for a trailing methodReturnFoo. And yes, this bit me. =============== Diff against VMMaker.oscog-eem.2792 =============== Item was added: + ----- Method: SmartSyntaxPluginTMethod>>endsWithMethodReturnExpression (in category 'testing') ----- + endsWithMethodReturnExpression + | operativeReturn | + operativeReturn := (parseTree statements last isReturn + and: [parseTree statements last expression isLeaf]) + ifTrue: [(parseTree statements last: 2) first] + ifFalse: [parseTree statements last]. + ^operativeReturn isSend + and: [#(methodReturnReceiver + methodReturnFloat: + methodReturnValue: + methodReturnInteger: + methodReturnBool: + methodReturnString: + methodReturnStringOrNil:) includes: operativeReturn selector]! Item was changed: ----- Method: SmartSyntaxPluginTMethod>>fixUpReturns (in category 'transforming') ----- fixUpReturns "Replace each return statement in this method with (a) the given postlog, (b) code to pop the receiver and the given number of arguments, and (c) code to push the integer result and return." + self endsWithMethodReturnExpression ifTrue: + [parseTree statements last isSend ifFalse: + [parseTree setStatements: parseTree statements allButLast]]. + parseTree nodesDo: + [:node | + node isStmtList ifTrue: + [node setStatements: (Array streamContents: - - parseTree nodesDo: [:node | - node isStmtList ifTrue: [ - node setStatements: (Array streamContents: [:sStream | node statements do: [:stmt | self fixUpReturnOneStmt: stmt on: sStream]])]]! From notifications at github.com Tue Aug 25 22:56:00 2020 From: notifications at github.com (Ken Dickey) Date: Tue, 25 Aug 2020 15:56:00 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) In-Reply-To: References: Message-ID: @KenDickey pushed 1 commit. c39f01fc1aa724d58e637c52f1b0e8e0a9ac1c9d Wheel events -- You are receiving this because you are subscribed to this thread. View it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515/files/6278529fa50c03ff62c680358c20674fc3373952..c39f01fc1aa724d58e637c52f1b0e8e0a9ac1c9d -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Thu Aug 27 15:26:11 2020 From: noreply at github.com (Eliot Miranda) Date: Thu, 27 Aug 2020 08:26:11 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] d16264: Add Apple Silicon entitlements (still no joy with ... Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: d16264b1558d88bdf178ff3d6e12f2fd18e3885c https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/d16264b1558d88bdf178ff3d6e12f2fd18e3885c Author: Eliot Miranda Date: 2020-08-27 (Thu, 27 Aug 2020) Changed paths: M .gitignore M build.macos64ARMv8/common/Makefile.app A build.macos64ARMv8/common/entitlements.plist Log Message: ----------- Add Apple Silicon entitlements (still no joy with lldb though). Clean up build directory .gitignore hackery. [ci skip] From noreply at github.com Thu Aug 27 15:30:12 2020 From: noreply at github.com (Eliot Miranda) Date: Thu, 27 Aug 2020 08:30:12 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 5d7098: Eliminate some funky Unicode "i" in sqUnixXdnd.c. ... Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 5d7098833153f9e03515384dd8c53f6597a7ef93 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/5d7098833153f9e03515384dd8c53f6597a7ef93 Author: Eliot Miranda Date: 2020-08-27 (Thu, 27 Aug 2020) Changed paths: M platforms/unix/vm-display-X11/sqUnixXdnd.c Log Message: ----------- Eliminate some funky Unicode "i" in sqUnixXdnd.c. [ci skip] From commits at source.squeak.org Fri Aug 28 02:28:19 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 28 Aug 2020 02:28:19 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2794.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2794.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2794 Author: eem Time: 27 August 2020, 7:28:10.09656 pm UUID: 81de711b-1533-4e7c-93a8-53c661352adc Ancestors: VMMaker.oscog-eem.2793 Fix long-standing confusion in generating the interface header files between the CoInterpreter and the Cogit. VM_EXPORT is the marker for export between the VM and external plugins (dlls/shared-objects). Between the CoInterpreter and the Cogit we need nothing more than extern. =============== Diff against VMMaker.oscog-eem.2793 =============== Item was changed: ----- Method: CCodeGenerator>>emitGlobalCVariablesOn: (in category 'C code generator') ----- emitGlobalCVariablesOn: aStream "Store the global (exported) variable declarations on the given stream." aStream cr; nextPutAll: '/*** Global Variables ***/'; cr. (self sortStrings: (variables select: [:v| vmClass mustBeGlobal: v])) do: [:var | | varString | (self variableDeclarationStringsForVariable: (varString := var asString)) do: [:decl| decl first == $# ifTrue: [aStream nextPutAll: decl; cr] ifFalse: [(decl includesSubstring: ' private ') ifFalse: "work-around hack to prevent localization of variables only referenced once." + [(decl beginsWith: 'static') ifFalse: + [aStream + nextPutAll: 'extern '; + nextPutAll: + ((decl includes: $=) + ifTrue: [decl copyFrom: 1 to: (decl indexOf: $=) - 1] + ifFalse: [decl]); + nextPut: $;; + cr]]]]]. - [(decl beginsWith: 'static') ifFalse: [aStream nextPutAll: 'VM_EXPORT ']. - aStream - nextPutAll: - ((decl includes: $=) - ifTrue: [decl copyFrom: 1 to: (decl indexOf: $=) - 1] - ifFalse: [decl]); - nextPut: $;; - cr]]]]. aStream cr! From noreply at github.com Fri Aug 28 02:48:20 2020 From: noreply at github.com (Eliot Miranda) Date: Thu, 27 Aug 2020 19:48:20 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 4b17e6: CogVM source as per VMMaker.oscog-eem.2794 Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 4b17e6e5daec9e302a3bb743016779e2d6d3100b https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/4b17e6e5daec9e302a3bb743016779e2d6d3100b Author: Eliot Miranda Date: 2020-08-27 (Thu, 27 Aug 2020) Changed paths: M nsspur64src/vm/cogit.h M nsspur64src/vm/cogitARMv8.c M nsspur64src/vm/cogitX64SysV.c M nsspur64src/vm/cogitX64WIN64.c M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cogitARMv5.c M nsspursrc/vm/cogitIA32.c M nsspursrc/vm/cogitMIPSEL.c M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M spur64src/vm/cogit.h M spur64src/vm/cogitARMv8.c M spur64src/vm/cogitX64SysV.c M spur64src/vm/cogitX64WIN64.c M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cogit.h M spurlowcode64src/vm/cogitARMv8.c M spurlowcode64src/vm/cogitX64SysV.c M spurlowcode64src/vm/cogitX64WIN64.c M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cogit.h M spurlowcodesrc/vm/cogitARMv5.c M spurlowcodesrc/vm/cogitIA32.c M spurlowcodesrc/vm/cogitMIPSEL.c M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spursista64src/vm/cogit.h M spursista64src/vm/cogitARMv8.c M spursista64src/vm/cogitX64SysV.c M spursista64src/vm/cogitX64WIN64.c M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cogitARMv5.c M spursistasrc/vm/cogitIA32.c M spursistasrc/vm/cogitMIPSEL.c M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cogitARMv5.c M spursrc/vm/cogitIA32.c M spursrc/vm/cogitMIPSEL.c M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M src/vm/cogit.h M src/vm/cogitARMv5.c M src/vm/cogitIA32.c M src/vm/cogitMIPSEL.c M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.2794 Fix long-standing confusion in generating the interface header files between the CoInterpreter and the Cogit. VM_EXPORT is the marker for export between the VM and external plugins (dlls/shared-objects). Between the CoInterpreter and the Cogit we need nothing more than extern. From builds at travis-ci.org Fri Aug 28 03:08:57 2020 From: builds at travis-ci.org (Travis CI) Date: Fri, 28 Aug 2020 03:08:57 +0000 Subject: [Vm-dev] Failed: OpenSmalltalk/opensmalltalk-vm#2144 (Cog - 4b17e6e) In-Reply-To: Message-ID: <5f48754941bfc_13fbdf7ed6f941264ed@travis-tasks-5578bdf6c4-ntchc.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2144 Status: Failed Duration: 20 mins and 4 secs Commit: 4b17e6e (Cog) Author: Eliot Miranda Message: CogVM source as per VMMaker.oscog-eem.2794 Fix long-standing confusion in generating the interface header files between the CoInterpreter and the Cogit. VM_EXPORT is the marker for export between the VM and external plugins (dlls/shared-objects). Between the CoInterpreter and the Cogit we need nothing more than extern. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/5d7098833153...4b17e6e5daec View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/721891897?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Fri Aug 28 03:33:07 2020 From: noreply at github.com (Eliot Miranda) Date: Thu, 27 Aug 2020 20:33:07 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 03812e: Semi-document the failonffiexception command line ... Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 03812efd76a01b3c3d1838ada743f72d985d74b6 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/03812efd76a01b3c3d1838ada743f72d985d74b6 Author: Eliot Miranda Date: 2020-08-27 (Thu, 27 Aug 2020) Changed paths: M platforms/iOS/vm/OSX/sqSqueakOSXApplication.m M platforms/unix/vm/sqUnixMain.c M platforms/win32/vm/sqWin32Window.c Log Message: ----------- Semi-document the failonffiexception command line argument (haven't yet doc'ed nofailonffiexception). From builds at travis-ci.org Fri Aug 28 03:54:07 2020 From: builds at travis-ci.org (Travis CI) Date: Fri, 28 Aug 2020 03:54:07 +0000 Subject: [Vm-dev] Still Failing: OpenSmalltalk/opensmalltalk-vm#2145 (Cog - 03812ef) In-Reply-To: Message-ID: <5f487fdf121cb_13fb2586c79e8174472@travis-tasks-5578bdf6c4-zs6nv.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2145 Status: Still Failing Duration: 20 mins and 25 secs Commit: 03812ef (Cog) Author: Eliot Miranda Message: Semi-document the failonffiexception command line argument (haven't yet doc'ed nofailonffiexception). View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/4b17e6e5daec...03812efd76a0 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/721898326?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Fri Aug 28 04:21:22 2020 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Thu, 27 Aug 2020 21:21:22 -0700 Subject: [Vm-dev] ARMv8 status Message-ID: Hi All, I hope I can clear up some confusion as to the status of ARMv8/aarch64 support in the opensmalltalk-vm. Executive summary: ARMv8 stack and cog VMs fully functional on e.g. Raspberry Pi 4, except for a special case in the FFI (structs containing all floats). The stack interpreter is functional on beta Apple Silicon. Work is in progress to get the Cogit VM working there-on. Gory details: The core VM works in both stack and cogit versions. A bug with integer multip-ly was fixed in early June that fixed bugs that appeared to be in large integer arithmetic (e.g. 100 factorial answered an incorrect value_. This bug was due to the Cogit not generating code that checked for overflow in integer multiple, and this was due to my having not noticed that ARMv8 does not set the overflow flag for integer multiple. The fix was to generate a proper checking sequence (the upper 64 bits of a 64x64=>128 bit multiply should be 0 or all ones). The major known bug is in the FFI. The ARMv8 procedure calling standard defines Homogenous Floating Aggregates (HFAs) and Homogenous Vector Aggregates (HVAs). The former are e.g. C structs whose components are all floats or all doubles. The latter are structs whose components are all the same and of two to four scalar data types. If argument registers are available then values of these types will be passed *and* returned in registers. The bug is that the ThreadedARMv8Plgin does not currently implement this mapping for floating-point values. This manifests in 6 ffi tests failing and two generating errors (provided the -failonffiexception VM argument is used; if it is not supplied, the VM crashes). While I don't have time to work on this at the moment, I'm sure that either Nicolas or myself will get to this before too long. But if your interface does not use HFAs or HVAs we believe the FFI is functional. Implementors interested in the issue can find the procedure call standard on this page, hit the Download button to access: https://developer.arm.com/documentation/ihi0055/b/ Fabio and I are currently working on Apple Silicon support, very much in our spare time. Apple Silicon is the same Apple gives to its own ARMv8 implementation, the A12 (used in beta macos hardware) and the A13. Currently we have the stack interpreter working, but not the Cogit. The issue right now is getting the lldb debugger to debug the Cogit so we can correctly set up memory at startup, Apple having introduced, or rather ported, the iPhone security architecture to MacOS, meaning that jitting code and debugging are carefully controlled actions that need :entitlements" setting in an executable. So far I *think* the entitlements are being set correctly, but for some reason lldb is still not able to launch or attach to either the stack or the cog VMs. So while we're stuck at the moment, Apple is quite responsive in its beta programme and I'm two messages deep in the exchange on getting lldb to work. So I expect progress soon. _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From stes at telenet.be Fri Aug 28 17:31:27 2020 From: stes at telenet.be (stes@PANDORA.BE) Date: Fri, 28 Aug 2020 19:31:27 +0200 (CEST) Subject: [Vm-dev] SQUEAK_SPY environment variable Message-ID: <1373597778.92009681.1598635887443.JavaMail.zimbra@telenet.be> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Does anybody know what the -spy option or the variable SQUEAK_SPY is doing ? platforms/unix/vm-display-X11/sqUnixX11.c:int withSpy= 0; platforms/unix/vm-display-X11/sqUnixX11.c: if (getenv("SQUEAK_SPY")) withSpy= 1; platforms/unix/vm/sqUnixMain.c: int withSpy= 0; platforms/unix/vm/sqUnixMain.c: else if (!strcmp(argv[0], VMOPTION("spy"))) { withSpy = 1; return 1; } Also I wonder why both .c files (sqUnixX11.c and sqUnixMain.c) both define the same global variable (they both define withSpy). I'd expect one of them to define it, and the other declare it extern. But I don't immediately see where 'withSpy' is used. David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfST8iAAoJEAwpOKXMq1MaU6cH/RmKzH2tRKLan4gdI8NDaVow XGOT09pmKjZNqiRxd8DAGXQ+4X/SopbLv6n7qRKFVCyscH9KRQPiZ5SwV36cKAYo Pwiekgn7G0g1choGne4Xav8HJTBsbZ6Q5zEiB8razD7ScYFwLVkP6ghY2QtAAfkY wa88aOsDyZjIpLOgEO/PXIyioZ4Qi5mr333FmjAHLON+P4Z4oRRXuRNuWFThf70y 2334DMxTwCXgFUY/zfBSR1YGvUPu1no558AYZPjI137xZ4fk93mMSBDAu4koFMeI XQkSRrf7fw9wZGemg6Lpe43S9OAO/HNFJJokgjuZOTIPuNUzjMamCD9UDf6BZX0= =3zbk -----END PGP SIGNATURE----- From stes at telenet.be Fri Aug 28 17:45:19 2020 From: stes at telenet.be (stes@PANDORA.BE) Date: Fri, 28 Aug 2020 19:45:19 +0200 (CEST) Subject: [Vm-dev] SQUEAK_SPY environment variable In-Reply-To: <1373597778.92009681.1598635887443.JavaMail.zimbra@telenet.be> References: <1373597778.92009681.1598635887443.JavaMail.zimbra@telenet.be> Message-ID: <427983742.92050950.1598636719200.JavaMail.zimbra@telenet.be> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 When I set the variable, $ export SQUEAK_SPY=1 $ /usr/bin/squeak Squeak5.3-19431-64bit.image It seems to have no effect, but maybe I'm mistaken. There's a description ./unix/vm/sqUnixMain.c: printf(" "VMOPTION("spy")" enable the system spy\n"); But what is the effect precisely of 'enabling the system spy" ?? Thanks! David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfSUJBAAoJEAwpOKXMq1Max1QH/0UfOkmbjk3XpRwdPakTxWGd u98XBw7QB+NZdBB3LQwOWnTSticFW35IPuljCIQQ0a9FAKT7wJAzsBbYbe/+p/cT EZFzjGyoB/rbMiqjwe5qROti0QFNqFsXs7Lr419Tti12TZXjiOZAULBKFcAw5pKk I4sIPn7RgPQbBSwfZsJs43FgK1I9+IEZTIM3IUOmn+7SjmUbRz5gW1iQpoYMdQD8 4gfbzuNh20qniiH/8Y2z5v6Uq6dcH6nNDdAvVcoR6oZiSCafFXuCXigHCYZzNlAk HrKH0nUc/UeFClAOUDPf2Nkg2Bp20FmNXqckTKhdIZBAfHf6B01ZXTrv1NavTE4= =E3OR -----END PGP SIGNATURE----- From stes at telenet.be Fri Aug 28 18:19:34 2020 From: stes at telenet.be (stes@PANDORA.BE) Date: Fri, 28 Aug 2020 20:19:34 +0200 (CEST) Subject: [Vm-dev] SQUEAK_SPY environment variable In-Reply-To: <427983742.92050950.1598636719200.JavaMail.zimbra@telenet.be> References: <1373597778.92009681.1598635887443.JavaMail.zimbra@telenet.be> <427983742.92050950.1598636719200.JavaMail.zimbra@telenet.be> Message-ID: <594823890.92151697.1598638774853.JavaMail.zimbra@telenet.be> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Maybe the VM -spy option is somehow related to spyOn: and MessageTally ?? http://wiki.squeak.org/squeak/4210 It's just a guess. I don't immediately see any documentation on this on wiki.squeak.org. Perhaps -spy is related to Squeak Performance Tuning ? David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfSUp7AAoJEAwpOKXMq1Man20H/RfGW/v9VQK7h2XcbQ0Tfu0s g4Bd+hbxK/dFfb2++M6dYhv14abFiXsbOIQNFZ8R4+koFCrWyplMLpYW98mscNU8 nJZR8UyNvhRB7GGNYYcUwpG6tKOBeObPSnviII8DCrNFFv7lOury6kiXryraOYtJ Baq2Qsx7dS40AsI1ALfXiFL7Vgk9sr975L/iEdPnjkGJ8HU6hFg827yN7C59DhVx QLW156AUZ1yDX9pHACzZK7dasaFOyFLLBv/umnsXcpzyquYVvDTlSlWR+Q8JA+eO J3V2DKOSrGFNkcVFT58ZaI04W7n5lLHY7admkF7mOpFD8ES/K8p0mdRBLZsqPaA= =NVsy -----END PGP SIGNATURE----- From notifications at github.com Sat Aug 29 23:21:44 2020 From: notifications at github.com (Ken Dickey) Date: Sat, 29 Aug 2020 16:21:44 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) In-Reply-To: References: Message-ID: @KenDickey pushed 1 commit. 889a93bfc69ff14fcd2e5820cec22d68cb9b0348 Updated usage notes -- You are receiving this because you are subscribed to this thread. View it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515/files/c39f01fc1aa724d58e637c52f1b0e8e0a9ac1c9d..889a93bfc69ff14fcd2e5820cec22d68cb9b0348 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sat Aug 29 23:24:04 2020 From: notifications at github.com (Ken Dickey) Date: Sat, 29 Aug 2020 16:24:04 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) In-Reply-To: References: Message-ID: @KenDickey pushed 1 commit. 59ad054d8ce5726bd5741280c063d8a1cabe69c1 Works with amd64 as well as aarch64 -- You are receiving this because you are subscribed to this thread. View it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515/files/889a93bfc69ff14fcd2e5820cec22d68cb9b0348..59ad054d8ce5726bd5741280c063d8a1cabe69c1 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sun Aug 30 00:34:36 2020 From: notifications at github.com (Eliot Miranda) Date: Sat, 29 Aug 2020 17:34:36 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] ThreadedFFIPlugin can access stale objects after a callout. (#516) Message-ID: In structure return the FFIPlugin creates an instance of the return type (retType in ffiReturnStruct:ofType:in:), but the return type has been fetched from the stack or method *before* the callout, not after. This should be fixed, but it needs thought to determine the best way to access the type object. -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/516 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sun Aug 30 00:40:25 2020 From: notifications at github.com (Eliot Miranda) Date: Sat, 29 Aug 2020 17:40:25 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] ThreadedFFIPlugin ffiReturnStruct:ofType:in: can be refactored. (#517) Message-ID: Currently some implementations of ffiReturnStruct:ofType:in: have knowledge about whether structs are returned in registers or not (a nice recent improvement by Nicolas Cellier). However, it would be better if this information was pulled out into the caller. Then there would be a single ffiReturnStruct:ofType:in: that would be passed a painter. The pointer should be something like self structResultPointerFor: calloutState and: ... In fixing the ARMv8 ThreadedFFIPlugin for the case of Homogenous Float Arrays it was necessary to have two separate invocations of ffiReturnStruct:ofType:in:, one for the float return and one for a normal struct return which may be returned in integer registers or through memory. On ARMv8 a struct can be returned through memory, in integer registers or in floating-point registers. So putting the logic in ffiReturnStruct:ofType:in: isn't as good as putting the logic in the caller ffiCalloutTo:SpecOnStack:in: -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/517 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sun Aug 30 00:44:22 2020 From: notifications at github.com (Eliot Miranda) Date: Sat, 29 Aug 2020 17:44:22 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) In-Reply-To: References: Message-ID: @eliotmiranda approved this pull request. -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515#pullrequestreview-478163056 -------------- next part -------------- An HTML attachment was scrubbed... URL: From notifications at github.com Sun Aug 30 00:48:00 2020 From: notifications at github.com (Eliot Miranda) Date: Sat, 29 Aug 2020 17:48:00 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) In-Reply-To: References: Message-ID: @eliotmiranda pushed 1 commit. c8946a46dd8f70ff04c3e9b464d4c4a37c7e6264 Merge branch 'Cog' into Cog -- You are receiving this because you are subscribed to this thread. View it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515/files/59ad054d8ce5726bd5741280c063d8a1cabe69c1..c8946a46dd8f70ff04c3e9b464d4c4a37c7e6264 -------------- next part -------------- An HTML attachment was scrubbed... URL: From noreply at github.com Sun Aug 30 00:49:02 2020 From: noreply at github.com (Eliot Miranda) Date: Sat, 29 Aug 2020 17:49:02 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] ab9f3b: just a start Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: ab9f3b6cdf6159fcfebeb28c4a0d8ff27bdd19db https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ab9f3b6cdf6159fcfebeb28c4a0d8ff27bdd19db Author: KenDickey Date: 2020-08-03 (Mon, 03 Aug 2020) Changed paths: A platforms/unix/vm-display-fbdev/sqUnixEvdevKeyboard.c A platforms/unix/vm-display-fbdev/sqUnixEvdevKeymap.c A platforms/unix/vm-display-fbdev/sqUnixEvdevMouse.c Log Message: ----------- just a start Commit: 182cc2c9254cd48f1fadbe0baffd565d1abbe66d https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/182cc2c9254cd48f1fadbe0baffd565d1abbe66d Author: KenDickey Date: 2020-08-03 (Mon, 03 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixFBDev.c Log Message: ----------- adding Evdev Commit: 0c22aace0488b0b4342a0022eaa0c8ed97731c41 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/0c22aace0488b0b4342a0022eaa0c8ed97731c41 Author: KenDickey Date: 2020-08-03 (Mon, 03 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/00_README.fbdev Log Message: ----------- evdev Commit: 0a229a10acc32a8b917054162b25034f612b9a64 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/0a229a10acc32a8b917054162b25034f612b9a64 Author: KenDickey Date: 2020-08-04 (Tue, 04 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyboard.c M platforms/unix/vm-display-fbdev/sqUnixEvdevMouse.c Log Message: ----------- much unparsed code Commit: 9549dcb00aa495331962d38b732aa5e6a2a42d71 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/9549dcb00aa495331962d38b732aa5e6a2a42d71 Author: KenDickey Date: 2020-08-04 (Tue, 04 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyboard.c M platforms/unix/vm-display-fbdev/sqUnixEvdevMouse.c Log Message: ----------- mumble Commit: 387d8ebd1f6bab7be9768f63f7a1116616d7fc27 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/387d8ebd1f6bab7be9768f63f7a1116616d7fc27 Author: KenDickey Date: 2020-08-06 (Thu, 06 Aug 2020) Changed paths: A platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c Log Message: ----------- simplify Commit: d9c7be92d4c186b90df508994113aa0091745955 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/d9c7be92d4c186b90df508994113aa0091745955 Author: KenDickey Date: 2020-08-06 (Thu, 06 Aug 2020) Changed paths: A platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c Log Message: ----------- commentary Commit: bddaf7e8631bda3194179c000a35bbb01112f208 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/bddaf7e8631bda3194179c000a35bbb01112f208 Author: KenDickey Date: 2020-08-07 (Fri, 07 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixFBDev.c Log Message: ----------- a bit closer (unparsed) Commit: 655d536656c25eada39501c7d628ca21f8b7f649 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/655d536656c25eada39501c7d628ca21f8b7f649 Author: KenDickey Date: 2020-08-08 (Sat, 08 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c M platforms/unix/vm-display-fbdev/sqUnixFBDev.c Log Message: ----------- parses;untested Commit: abc0cd01896fd7c72560b64b811526c9744faa71 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/abc0cd01896fd7c72560b64b811526c9744faa71 Author: KenDickey Date: 2020-08-09 (Sun, 09 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixFBDev.c Log Message: ----------- basic evdev mouse & keyboard Commit: 43af5aea3594e8d66389777b168a9b64b95e32e0 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/43af5aea3594e8d66389777b168a9b64b95e32e0 Author: KenDickey Date: 2020-08-09 (Sun, 09 Aug 2020) Changed paths: M build.linux64ARMv8/squeak.stack.spur/build.debug/mvm M build.linux64ARMv8/squeak.stack.spur/build/mvm M platforms/Cross/vm/sqVirtualMachine.c R platforms/unix/vm-display-fbdev/sqUnixEvdevKeyboard.c R platforms/unix/vm-display-fbdev/sqUnixEvdevKeymap.c R platforms/unix/vm-display-fbdev/sqUnixEvdevMouse.c M platforms/unix/vm/debug.h M platforms/unix/vm/sqUnixMain.c Log Message: ----------- build flags - stdoutStack Commit: 8eda0134a0308aa84b92e9a444ff8a845f87573e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/8eda0134a0308aa84b92e9a444ff8a845f87573e Author: KenDickey Date: 2020-08-10 (Mon, 10 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- display looks good Commit: a2a09546f21dd3246349c5cb3e7d1d920ce2fcc7 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/a2a09546f21dd3246349c5cb3e7d1d920ce2fcc7 Author: KenDickey Date: 2020-08-10 (Mon, 10 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c Log Message: ----------- cursor tracks now; no kbd Commit: ab7cd135dff678acb91da8f0b2340cc43e3bd5c0 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ab7cd135dff678acb91da8f0b2340cc43e3bd5c0 Author: KenDickey Date: 2020-08-11 (Tue, 11 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c Log Message: ----------- still lacking mouse button events Commit: 9a8b6d14c22fd8a20f8fab28ddc0cd6f9cf6f211 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/9a8b6d14c22fd8a20f8fab28ddc0cd6f9cf6f211 Author: KenDickey Date: 2020-08-12 (Wed, 12 Aug 2020) Changed paths: A platforms/unix/vm-display-fbdev/Balloon.h M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- because white pixels are boring Commit: cefe64708ba2a2fe162e098b362b820ec924b536 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/cefe64708ba2a2fe162e098b362b820ec924b536 Author: KenDickey Date: 2020-08-12 (Wed, 12 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixFBDev.c Log Message: ----------- latest trial Commit: 3803a80dbfbf2623a86f85646a8a0cd4d93bacd7 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/3803a80dbfbf2623a86f85646a8a0cd4d93bacd7 Author: KenDickey Date: 2020-08-13 (Thu, 13 Aug 2020) Changed paths: M build.linux64ARMv8/squeak.cog.spur/build/mvm M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c Log Message: ----------- mouse buttons seen Commit: 75832b1d606169251c1ad42e9e9a309c4de72993 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/75832b1d606169251c1ad42e9e9a309c4de72993 Author: KenDickey Date: 2020-08-14 (Fri, 14 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- basics work Commit: db2b422b2438bbf5acee13ad5a35db9ce712951f https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/db2b422b2438bbf5acee13ad5a35db9ce712951f Author: KenDickey Date: 2020-08-14 (Fri, 14 Aug 2020) Changed paths: M build.linux64ARMv8/squeak.cog.spur/build/mvm M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c Log Message: ----------- keymap fixups Commit: 33983b11b2860a49531a7f752cc54c5df3b4930f https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/33983b11b2860a49531a7f752cc54c5df3b4930f Author: KenDickey Date: 2020-08-16 (Sun, 16 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c Log Message: ----------- elided X11 cruft Commit: ecb3a853e00dcb1ac04e6395b82738fd16c9c162 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ecb3a853e00dcb1ac04e6395b82738fd16c9c162 Author: KenDickey Date: 2020-08-16 (Sun, 16 Aug 2020) Changed paths: M build.linux64ARMv8/squeak.stack.spur/build.debug/mvm M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- static fbSelf Commit: 8740796c610b002763d5d46ac03a8829cf39c7da https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/8740796c610b002763d5d46ac03a8829cf39c7da Author: Linux User Date: 2020-08-18 (Tue, 18 Aug 2020) Changed paths: A AlpineLinux-Notes.txt Log Message: ----------- useful Commit: 48a32528a5e77bccb661159c6a8fa8b005d98526 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/48a32528a5e77bccb661159c6a8fa8b005d98526 Author: Linux User Date: 2020-08-17 (Mon, 17 Aug 2020) Changed paths: A build.linux64ARMv8/HowToBuild Log Message: ----------- dup Commit: 27d524cfcde8d23b06319445002e4d220c65b4f2 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/27d524cfcde8d23b06319445002e4d220c65b4f2 Author: KenDickey Date: 2020-08-19 (Wed, 19 Aug 2020) Changed paths: M AlpineLinux-Notes.txt Log Message: ----------- added openssl-dev to apk Commit: d44807de5ea5326f3709790d5625ef03182b0445 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/d44807de5ea5326f3709790d5625ef03182b0445 Author: KenDickey Date: 2020-08-19 (Wed, 19 Aug 2020) Changed paths: M AlpineLinux-Notes.txt Log Message: ----------- hdmi boot config Commit: 2b2ea2de2af68faf3005ad5d3edbb583b752fc4e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2b2ea2de2af68faf3005ad5d3edbb583b752fc4e Author: KenDickey Date: 2020-08-19 (Wed, 19 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- cruft removal Commit: 2c2a9ea989c83b14f2f398cf9dd68a3d80dedb8d https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2c2a9ea989c83b14f2f398cf9dd68a3d80dedb8d Author: KenDickey Date: 2020-08-19 (Wed, 19 Aug 2020) Changed paths: M AlpineLinux-Notes.txt Log Message: ----------- shell vars Commit: 7a46ec6d1a53bab36787584dc7fbe00b18001cc7 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/7a46ec6d1a53bab36787584dc7fbe00b18001cc7 Author: KenDickey Date: 2020-08-20 (Thu, 20 Aug 2020) Changed paths: M build.linux64ARMv8/squeak.stack.spur/build.debug/mvm M platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- cursor looks OK now Commit: a400bd95c3e52a9d38802bbe0d9bf2473964cebc https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/a400bd95c3e52a9d38802bbe0d9bf2473964cebc Author: KenDickey Date: 2020-08-21 (Fri, 21 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- platform independent sizes (16ok|32no) Commit: f74203c8d525dd5763b98e1cb3beafa3bf037520 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/f74203c8d525dd5763b98e1cb3beafa3bf037520 Author: KenDickey Date: 2020-08-21 (Fri, 21 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- 32bit fb depth OK Commit: 1afa6e6a2755c0790446e774fb85a3c17e574c5e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/1afa6e6a2755c0790446e774fb85a3c17e574c5e Author: KenDickey Date: 2020-08-21 (Fri, 21 Aug 2020) Changed paths: M AlpineLinux-Notes.txt Log Message: ----------- reboot lossage fixup Commit: 42be8a22e6721f0b90180b140a4cf671fd26ad8a https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/42be8a22e6721f0b90180b140a4cf671fd26ad8a Author: KenDickey Date: 2020-08-21 (Fri, 21 Aug 2020) Changed paths: M AlpineLinux-Notes.txt Log Message: ----------- 32 bit depth works Commit: 276fe4ce40da9559ff47f3b85e968ef5bbf949ab https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/276fe4ce40da9559ff47f3b85e968ef5bbf949ab Author: KenDickey Date: 2020-08-21 (Fri, 21 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c Log Message: ----------- cmd-. works Commit: 204f7b960b1da849869749cb2c73af594c115000 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/204f7b960b1da849869749cb2c73af594c115000 Author: KenDickey Date: 2020-08-21 (Fri, 21 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- shorted splash screen display time Commit: 6278529fa50c03ff62c680358c20674fc3373952 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/6278529fa50c03ff62c680358c20674fc3373952 Author: KenDickey Date: 2020-08-22 (Sat, 22 Aug 2020) Changed paths: A Armbian-Notes.txt Log Message: ----------- new Commit: c39f01fc1aa724d58e637c52f1b0e8e0a9ac1c9d https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/c39f01fc1aa724d58e637c52f1b0e8e0a9ac1c9d Author: KenDickey Date: 2020-08-25 (Tue, 25 Aug 2020) Changed paths: M platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c Log Message: ----------- Wheel events Commit: 889a93bfc69ff14fcd2e5820cec22d68cb9b0348 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/889a93bfc69ff14fcd2e5820cec22d68cb9b0348 Author: KenDickey Date: 2020-08-29 (Sat, 29 Aug 2020) Changed paths: R AlpineLinux-Notes.txt R Armbian-Notes.txt A platforms/unix/vm-display-fbdev/AlpineLinux-Notes.txt A platforms/unix/vm-display-fbdev/Armbian-Notes.txt Log Message: ----------- Updated usage notes Commit: 59ad054d8ce5726bd5741280c063d8a1cabe69c1 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/59ad054d8ce5726bd5741280c063d8a1cabe69c1 Author: KenDickey Date: 2020-08-29 (Sat, 29 Aug 2020) Changed paths: M build.linux64ARMv8/HowToBuild Log Message: ----------- Works with amd64 as well as aarch64 Commit: c8946a46dd8f70ff04c3e9b464d4c4a37c7e6264 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/c8946a46dd8f70ff04c3e9b464d4c4a37c7e6264 Author: Eliot Miranda Date: 2020-08-29 (Sat, 29 Aug 2020) Changed paths: M .gitignore M build.linux64ARMv8/HowToBuild M build.macos32x86/common/Makefile.vm M build.macos64ARMv8/common/Makefile.app M build.macos64ARMv8/common/Makefile.flags M build.macos64ARMv8/common/Makefile.vm A build.macos64ARMv8/common/entitlements.plist M build.macos64ARMv8/makeallinstall M build.macos64ARMv8/makeproduct M build.macos64ARMv8/squeak.cog.spur/plugins.ext M build.macos64x64/common/Makefile.flags M build.macos64x64/common/Makefile.vm M nsspur64src/vm/cogit.h M nsspur64src/vm/cogitARMv8.c M nsspur64src/vm/cogitX64SysV.c M nsspur64src/vm/cogitX64WIN64.c M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cogitARMv5.c M nsspursrc/vm/cogitIA32.c M nsspursrc/vm/cogitMIPSEL.c M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c M platforms/Cross/plugins/FloatMathPlugin/ieee754names.h M platforms/Cross/plugins/IA32ABI/arm32abicc.c M platforms/Cross/plugins/IA32ABI/arm64abicc.c M platforms/Cross/plugins/IA32ABI/dabusiness.h M platforms/Cross/plugins/IA32ABI/dabusinessARM.h M platforms/Cross/plugins/IA32ABI/dabusinessARM32.h M platforms/Cross/plugins/IA32ABI/dabusinessARM64.h M platforms/Cross/plugins/IA32ABI/dabusinessPostLogic.h M platforms/Cross/plugins/IA32ABI/dabusinessppc.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicDouble.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicFloat.h M platforms/Cross/plugins/IA32ABI/dabusinessppcPostLogicInteger.h M platforms/Cross/plugins/IA32ABI/ia32abicc.c M platforms/Cross/plugins/IA32ABI/ppc32abicc.c M platforms/Cross/plugins/IA32ABI/x64sysvabicc.c M platforms/Cross/plugins/IA32ABI/x64win64abicc.c M platforms/Cross/vm/sq.h M platforms/Cross/vm/sqAssert.h M platforms/Mac OS/vm/sqMacMain.c M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.h M platforms/iOS/plugins/SoundPlugin/sqSqueakSoundCoreAudio.m M platforms/iOS/vm/Common/Classes/sqSqueakMainApp.m M platforms/iOS/vm/OSX/sqSqueakOSXApplication+attributes.m M platforms/iOS/vm/OSX/sqSqueakOSXApplication.m M platforms/iOS/vm/OSX/sqSqueakOSXScreenAndWindow.m M platforms/iOS/vm/iPhone/Classes/sqSqueakIPhoneApplication+attributes.m M platforms/iOS/vm/iPhone/Classes/sqSqueakIPhoneApplication.m M platforms/minheadless/generic/sqPlatformSpecific-Generic.c M platforms/minheadless/unix/sqPlatformSpecific-Unix.c M platforms/minheadless/windows/sqPlatformSpecific-Win32.c M platforms/unix/vm-display-X11/sqUnixXdnd.c M platforms/unix/vm/include_ucontext.h M platforms/unix/vm/sqUnixMain.c M platforms/win32/vm/sqWin32VMProfile.c M platforms/win32/vm/sqWin32Window.c M spur64src/vm/cogit.h M spur64src/vm/cogitARMv8.c M spur64src/vm/cogitX64SysV.c M spur64src/vm/cogitX64WIN64.c M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cogit.h M spurlowcode64src/vm/cogitARMv8.c M spurlowcode64src/vm/cogitX64SysV.c M spurlowcode64src/vm/cogitX64WIN64.c M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cogit.h M spurlowcodesrc/vm/cogitARMv5.c M spurlowcodesrc/vm/cogitIA32.c M spurlowcodesrc/vm/cogitMIPSEL.c M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spurlowcodestack64src/vm/gcc3x-interp.c M spurlowcodestack64src/vm/interp.c M spurlowcodestacksrc/vm/gcc3x-interp.c M spurlowcodestacksrc/vm/interp.c M spursista64src/vm/cogit.h M spursista64src/vm/cogitARMv8.c M spursista64src/vm/cogitX64SysV.c M spursista64src/vm/cogitX64WIN64.c M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cogitARMv5.c M spursistasrc/vm/cogitIA32.c M spursistasrc/vm/cogitMIPSEL.c M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cogitARMv5.c M spursrc/vm/cogitIA32.c M spursrc/vm/cogitMIPSEL.c M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstack64src/vm/validImage.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M spurstacksrc/vm/validImage.c M src/ckformat.c M src/plugins/SecurityPlugin/SecurityPlugin.c M src/plugins/SoundPlugin/SoundPlugin.c M src/vm/cogit.h M src/vm/cogitARMv5.c M src/vm/cogitIA32.c M src/vm/cogitMIPSEL.c M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c M stacksrc/vm/gcc3x-interp.c M stacksrc/vm/interp.c Log Message: ----------- Merge branch 'Cog' into Cog Commit: 57d91d0d2f973e09b46fde76f9f1dc2ec302a1f5 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/57d91d0d2f973e09b46fde76f9f1dc2ec302a1f5 Author: Eliot Miranda Date: 2020-08-29 (Sat, 29 Aug 2020) Changed paths: M build.linux64ARMv8/HowToBuild M build.linux64ARMv8/squeak.cog.spur/build/mvm M build.linux64ARMv8/squeak.stack.spur/build.debug/mvm M build.linux64ARMv8/squeak.stack.spur/build/mvm M platforms/Cross/vm/sqVirtualMachine.c M platforms/unix/vm-display-fbdev/00_README.fbdev A platforms/unix/vm-display-fbdev/AlpineLinux-Notes.txt A platforms/unix/vm-display-fbdev/Armbian-Notes.txt A platforms/unix/vm-display-fbdev/Balloon.h A platforms/unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c A platforms/unix/vm-display-fbdev/sqUnixEvdevKeycodeMap.c M platforms/unix/vm-display-fbdev/sqUnixFBDev.c M platforms/unix/vm-display-fbdev/sqUnixFBDevFramebuffer.c M platforms/unix/vm/debug.h M platforms/unix/vm/sqUnixMain.c Log Message: ----------- Merge pull request #515 from KenDickey/Cog vm-display-fbdev Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/03812efd76a0...57d91d0d2f97 From notifications at github.com Sun Aug 30 00:49:03 2020 From: notifications at github.com (Eliot Miranda) Date: Sat, 29 Aug 2020 17:49:03 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] vm-display-fbdev (#515) In-Reply-To: References: Message-ID: Merged #515 into Cog. -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/515#event-3706918542 -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Sun Aug 30 01:12:00 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 30 Aug 2020 01:12:00 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2795.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2795.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2795 Author: eem Time: 29 August 2020, 6:11:51.399954 pm UUID: 94ce8042-5549-46ab-b693-8d00f36d6d71 Ancestors: VMMaker.oscog-eem.2794 ThreadedARM64Plugin: Implement support for Homogenous Float Arrays (HVAs, structs with up to four float fields, or up to four double fields). These are passed and returned in floating-point argument registers, on call if sufficient are available. To implement this the ThreadedARM64Plugin uses a union of a struct containing four doubles, and a struct containing eight floats. All float/double/HVA returns are handled by a call that expects a struct of four doubles. hence Slang changes are needed (see below) to allow the struct to be conveniently defined with local methods. Mark all methods required to be inlined to be in the same funcuton as the alloca as inline: #always. Hence their code will only occur inlined, not a second time in an unused function. Tidy up, pulling the unaligned accessor macros out of the preamble and explicitly into methods, whether Slang has a chance to generate code correctly given their presence. Also make sure that all references to a type spec are typed as unsigned int/unsigned int *, including the callout state's ffiArgSpec. This fixes about five test cases in the FFI tests. Fix a warning by typing InterpreterProxy>>characterObjectOf:'s argument as int to agree with sqVirtualMachine.h. Slang: Fix several issues with inlining and type inferrence to support the above. Distinguish macros from struct accessors; previously isStructSend: could be confused. Make sure that structTargetKindForDeclaration: answers #pointer only for types endign with a *; previously it could be confused by e.g. a struct containing pointers. Make isTypePointerToStruct: more robust, answering false for anything that isn't a string and then analysing the string. emitCCodeAsFieldReferenceOn:level:generator: must also check for shouldGenerateAsInterpreterProxySend:. tryToInlineMethodsIn: must push the current method's declarations onto the scope stack to allow priper type inferrence while inlining. Since these changes now allow e.g. a structure method to be inlined, extend node:typeCompatibleWith:inliningInto:in: to inline such arguments; it needs to take the address of the argument to derive the lined pointer to the actual argument. =============== Diff against VMMaker.oscog-eem.2794 =============== Item was added: + ----- Method: CCodeGenerator>>isKernelMacroSelector: (in category 'utilities') ----- + isKernelMacroSelector: sel + "Answer if the given selector is one of the selectors implemented as a macro in platform header fiels." + + ^(self isKernelSelector: sel) + or: [VMBasicConstants mostBasicConstantSelectors includes: sel]! Item was added: + ----- Method: CCodeGenerator>>isMacroSelector: (in category 'utilities') ----- + isMacroSelector: sel + "Answer if the given selector is one of the selectors implemented as a macro in platform header fiels." + + ^(self isKernelSelector: sel) + or: [(VMBasicConstants mostBasicConstantSelectors includes: sel) + or: [(self methodNamed: sel) + ifNil: [false] + ifNotNil: [:m| m definedAsMacro]]]! Item was changed: ----- Method: CCodeGenerator>>node:typeCompatibleWith:inliningInto:in: (in category 'inlining') ----- node: exprNode typeCompatibleWith: argName inliningInto: targetMethod in: aTMethod "Answer either exprNode or, if required, a cast of exprNode to the type of argName. The cast is required if - argName is typed and exprNode is untyped - argName is untyped and exprNode is an arithmetic type of size > #sqInt - both argName and exprNode are typed but they are incompatible" | formalType actualType | formalType := targetMethod typeFor: argName in: self. actualType := self typeFor: exprNode in: aTMethod. + "First check for inlining a struct method/accessor" + ((argName beginsWith: 'self_in_') + and: [formalType last == $* + and: [(formalType beginsWith: actualType) + and: [(formalType allButFirst: actualType size) withBlanksTrimmed = '*']]]) ifTrue: + [^TSendNode new + setSelector: #addressOf: + receiver: (TVariableNode new setName: 'self') + arguments: { exprNode } + isBuiltInOp: false]. + "Second check for arithmetic coercion" + ((exprNode isSend or: [exprNode isVariable]) - ^((exprNode isSend or: [exprNode isVariable]) and: [(formalType notNil and: [actualType isNil]) or: [(formalType isNil and: [actualType notNil and: [(self isIntegralCType: actualType) and: [(self sizeOfIntegralCType: actualType) > (self sizeOfIntegralCType: #sqInt)]]]) or: [(self variableOfType: formalType acceptsValue: exprNode ofType: actualType) not]]]) + ifTrue: + [^self nodeToCast: exprNode to: (formalType ifNil: [#sqInt])]. + "Next check for type errors..." + ((exprNode isSend or: [exprNode isVariable]) + and: [(self + variableOfType: (targetMethod typeFor: argName in: self) + acceptsValue: exprNode + ofType: (self typeFor: exprNode in: aTMethod)) not]) ifTrue: + [logger + nextPutAll: + 'type mismatch for formal ', argName, ' and actual "', exprNode asString, + '" when inlining ', targetMethod selector, ' in ', aTMethod selector, '. Use a cast.'; + cr; flush]. + "No conversion is necessary, or there's a type error..." + ^exprNode! - ifTrue: [self nodeToCast: exprNode to: (formalType ifNil: [#sqInt])] - ifFalse: - [((exprNode isSend or: [exprNode isVariable]) - and: [(self - variableOfType: (targetMethod typeFor: argName in: self) - acceptsValue: exprNode - ofType: (self typeFor: exprNode in: aTMethod)) not]) ifTrue: - [logger - nextPutAll: - 'type mismatch for formal ', argName, ' and actual "', exprNode asString, - '" when inlining ', targetMethod selector, ' in ', aTMethod selector, '. Use a cast.'; - cr; flush]. - exprNode]! Item was changed: ----- Method: InterpreterProxy>>characterObjectOf: (in category 'object access') ----- characterObjectOf: characterCode + ^StackInterpreter objectMemoryClass characterObjectOf: characterCode! Item was changed: ----- Method: TMethod>>checkForCompletenessIn: (in category 'inlining support') ----- checkForCompletenessIn: aCodeGen "Set the complete flag if the parse tree contains no further candidates for inlining." | foundIncompleteSend incompleteSends | aCodeGen maybeBreakForTestOfInliningOf: selector. foundIncompleteSend := false. incompleteSends := IdentitySet new. parseTree nodesDo: [:node| node isSend ifTrue: [(self methodIsEffectivelyComplete: node selector in: aCodeGen) ifTrue: [(self inlineableFunctionCall: node in: aCodeGen) ifTrue: + [incompleteSends add: node. + complete := false. "more inlining to do" + ^self]] - [complete := false. "more inlining to do" - ^self]] ifFalse: [foundIncompleteSend := true. incompleteSends add: node]]] unless: [:node| node isSend and: [node selector == #cCode:inSmalltalk: or: [aCodeGen isAssertSelector: node selector]]]. foundIncompleteSend ifFalse: [complete := true]! Item was changed: ----- Method: TMethod>>inlineableFunctionCall:in: (in category 'inlining') ----- inlineableFunctionCall: aNode in: aCodeGen "Answer if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted." aCodeGen maybeBreakForTestToInline: aNode in: self. aNode isSend ifFalse: [^false]. + ((aCodeGen shouldGenerateAsInterpreterProxySend: aNode) + or: [aCodeGen isStructSend: aNode]) ifTrue: + [^false]. ^(aCodeGen methodNamed: aNode selector) ifNil: [aNode asTransformedConstantPerform ifNil: [self isInlineableConditional: aNode in: aCodeGen] ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]] ifNotNil: [:m| (m ~~ self and: [((m isFunctionalIn: aCodeGen) or: [m mustBeInlined and: [m isComplete]]) and: [m mayBeInlined and: [(aCodeGen mayInline: m selector) and: [aNode args allSatisfy: [:a| self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]) or: [m checkForRequiredInlinability]]! Item was changed: ----- Method: TMethod>>methodIsEffectivelyComplete:in: (in category 'inlining support') ----- methodIsEffectivelyComplete: selector in: aCodeGen "Answer if selector is effectively not inlineable in the receiver. This is tricky because block inlining requires that certain methods must be inlined, which can be at odds wuth the opportunistic strategy the inliner takes. Since the inliner only inlines complete methods and certain methods may never be marked as complete (e.g. recursive methods) we have to short-cut certain kinds of send. In particular, short-cut sends that turn into jumps in the interpret routine (sharedCase and sharedLabel below)." ^(aCodeGen methodNamed: selector) ifNil: [true] "builtins or externals are not inlineable" ifNotNil: [:m| m isComplete "unlinable methods can't be inlined" or: [m mayBeInlined not "Methods which are inlined as jumps don't need inlining" + or: [m sharedCase notNil or: [m sharedLabel notNil + "Macros and struct accessors don't need inlining" + or: [m definedAsMacro or: [m isStructAccessor]]]]]]! - or: [m sharedCase notNil or: [m sharedLabel notNil]]]]! Item was changed: ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') ----- tryToInlineMethodsIn: aCodeGen "Expand any (complete) inline methods sent by this method. Set the complete flag when all inlining has been done. Answer if something was inlined." - | didSomething statementLists | - "complete ifTrue: - [^false]." - self definedAsMacro ifTrue: [complete ifTrue: [^false]. ^complete := true]. + ^aCodeGen + pushScope: declarations + while: + [| didSomething statementLists | + self ensureConditionalAssignmentsAreTransformedIn: aCodeGen. + didSomething := self tryToInlineMethodStatementsIn: aCodeGen statementListsInto: [:stmtLists| statementLists := stmtLists]. + didSomething := (self tryToInlineMethodExpressionsIn: aCodeGen) or: [didSomething]. - self ensureConditionalAssignmentsAreTransformedIn: aCodeGen. - didSomething := self tryToInlineMethodStatementsIn: aCodeGen statementListsInto: [:stmtLists| statementLists := stmtLists]. - didSomething := (self tryToInlineMethodExpressionsIn: aCodeGen) or: [didSomething]. + didSomething ifTrue: + [writtenToGlobalVarsCache := nil]. - didSomething ifTrue: - [writtenToGlobalVarsCache := nil]. + complete ifFalse: + [self checkForCompletenessIn: aCodeGen. + complete ifTrue: [didSomething := true]]. "marking a method complete is progress" + didSomething]! - complete ifFalse: - [self checkForCompletenessIn: aCodeGen. - complete ifTrue: [didSomething := true]]. "marking a method complete is progress" - ^didSomething! Item was changed: ----- Method: TSendNode>>emitCCodeAsFieldReferenceOn:level:generator: (in category 'C code generation') ----- emitCCodeAsFieldReferenceOn: aStream level: level generator: aCodeGen "If appropriate, translate this message send as a pointer dereference" | parenCount | (aCodeGen isStructSend: self) ifFalse: [^false]. + (aCodeGen shouldGenerateAsInterpreterProxySend: self) ifTrue: + [^false]. parenCount := receiver isSend ifTrue: [2] ifFalse: [1]. aStream next: parenCount put: $(. receiver emitCCodeAsExpressionOn: aStream level: 0 generator: aCodeGen. parenCount > 1 ifTrue: [aStream nextPut: $)]. (receiver structTargetKindIn: aCodeGen) caseOf: { [#pointer] -> [aStream nextPut: $-; nextPut: $>]. [#struct] -> [aStream nextPut: $.] }. aStream nextPutAll: (aCodeGen cFunctionNameFor: selector). arguments isEmpty ifFalse: [self assert: arguments size = 1. aStream nextPutAll: ' = '. arguments first emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen]. aStream nextPut: $). ^true! Item was changed: ----- Method: ThreadedARM32FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" | myThreadIndex atomicType floatRet intRet | + - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState). calloutState floatRegisterIndex > 0 ifTrue: [self load: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 0)) to: 'double *') at: 0) Flo: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 2)) to: 'double *') at: 0) a: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 4)) to: 'double *') at: 0) t: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 6)) to: 'double *') at: 0) R: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 8)) to: 'double *') at: 0) e: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 10)) to: 'double *') at: 0) g: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 12)) to: 'double *') at: 0) s: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 14)) to: 'double *') at: 0)]. (self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector]. atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3)] ifFalse: "atomicType = FFITypeDoubleFloat" [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3)]. "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. interpreterProxy ownVM: myThreadIndex. ^interpreterProxy floatObjectOf: floatRet]. intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3). "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. interpreterProxy ownVM: myThreadIndex. (calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: ["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiReturnStruct: (self addressOf: intRet) ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState! Item was added: + ----- Method: ThreadedARM64FFIPlugin class>>isStructType: (in category 'translation') ----- + isStructType: typeName + | space | + ^(space := typeName indexOf: Character space) > 0 + and: [#(union struct) includes: (typeName copyFrom: 1 to: space - 1)]! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>d (in category 'translation support') ----- + d + "Hack for floatRet in ffiCalloutTo:SpecOnStack:in:" + + "to make it disappear..." + ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>doubles (in category 'translation support') ----- + doubles + "Hack for floatRet in ffiCalloutTo:SpecOnStack:in:" + + "to make it disappear..." + ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>f (in category 'translation support') ----- + f + "Hack for floatRet in ffiCalloutTo:SpecOnStack:in:" + + "to make it disappear..." + ^0! Item was changed: ----- Method: ThreadedARM64FFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') ----- ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs "Generic callout. Does the actual work. If argArrayOrNil is nil it takes args from the stack and the spec from the method. If argArrayOrNil is not nil takes args from argArrayOrNil and the spec from the receiver." | flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result primNumArgs | + - primNumArgs := interpreterProxy methodArgumentCount. (interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse: [^self ffiFail: FFIErrorNotFunction]. "Load and check the values in the externalFunction before we call out" flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction. interpreterProxy failed ifTrue: [^self ffiFail: FFIErrorBadArgs]. "This must come early for compatibility with the old FFIPlugin. Image-level code may assume the function pointer is loaded eagerly. Thanks to Nicolas Cellier." address := self ffiLoadCalloutAddress: externalFunction. interpreterProxy failed ifTrue: [^0 "error code already set by ffiLoadCalloutAddress:"]. argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction. "must be array of arg types" ((interpreterProxy isArray: argTypeArray) and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse: [^self ffiFail: FFIErrorBadArgs]. "check if the calling convention is supported" self cppIf: COGMTVM ifTrue: [(self ffiSupportsCallingConvention: (flags bitAnd: FFICallTypesMask)) ifFalse: [^self ffiFail: FFIErrorCallType]] ifFalse: "not masking causes threaded calls to fail, which is as they should if the plugin is not threaded." [(self ffiSupportsCallingConvention: flags) ifFalse: [^self ffiFail: FFIErrorCallType]]. requiredStackSize := self externalFunctionHasStackSizeSlot ifTrue: [interpreterProxy fetchInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction] ifFalse: [-1]. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: (argArrayOrNil isNil ifTrue: [PrimErrBadMethod] ifFalse: [PrimErrBadReceiver])]. stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize]. self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new]. calloutState := self addressOf: theCalloutState. self cCode: [self memset: calloutState _: 0 _: (self sizeof: #CalloutState)]. calloutState callFlags: flags. "Fetch return type and args" argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray. argSpec := interpreterProxy fetchPointer: 0 ofObject: argType. argClass := interpreterProxy fetchPointer: 1 ofObject: argType. (err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue: [^self ffiFail: err]. "cannot return" "alloca the outgoing stack frame, leaving room for marshalling args, and including space for the return struct, if any. Additional space reserved for saving register args like mandated by Win64 X64 or PPC ABI, will be managed by the call itself" allocation := self alloca: stackSize + calloutState structReturnSize + self cStackAlignment. self mustAlignStack ifTrue: [allocation := self cCoerce: (allocation asUnsignedIntegerPtr bitClear: self cStackAlignment - 1) to: #'char *']. calloutState argVector: allocation; currentArg: allocation; limit: allocation + stackSize. 1 to: nArgs do: [:i| argType := interpreterProxy fetchPointer: i ofObject: argTypeArray. argSpec := interpreterProxy fetchPointer: 0 ofObject: argType. argClass := interpreterProxy fetchPointer: 1 ofObject: argType. oop := argArrayOrNil isNil ifTrue: [interpreterProxy stackValue: nArgs - i] ifFalse: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil]. err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState. err ~= 0 ifTrue: [self cleanupCalloutState: calloutState. self cppIf: COGMTVM ifTrue: [err = PrimErrObjectMayMove negated ifTrue: [^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry." ^self ffiFail: err]]. "coercion failed or out of stack space" "Failures must be reported back from ffiArgument:Spec:Class:in:. Should not fail from here on in." self assert: interpreterProxy failed not. self ffiLogCallout: externalFunction. (requiredStackSize < 0 and: [self externalFunctionHasStackSizeSlot]) ifTrue: [stackSize := calloutState currentArg - calloutState argVector. interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize]. "Go out and call this guy" result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState. self cleanupCalloutState: calloutState. "Can not safely use argumentCount (via e.g. methodReturnValue:) since it may have been changed by a callback." interpreterProxy pop: primNumArgs + 1 thenPush: result. ^result! Item was changed: ----- Method: ThreadedARM64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" + | myThreadIndex atomicType floatRet intRet x1Ret specSize | + - | myThreadIndex atomicType floatRet intRet x1Ret | - + + self cCode: [] inSmalltalk: [floatRet := ByteArray new: 32]. "Just a hack to placate the Smalltalk compiler; this shoudl be a proper struct..." - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState). calloutState floatRegisterIndex > 0 ifTrue: [self loadFloatRegs: (calloutState floatRegisters at: 0) _: (calloutState floatRegisters at: 1) _: (calloutState floatRegisters at: 2) _: (calloutState floatRegisters at: 3) _: (calloutState floatRegisters at: 4) _: (calloutState floatRegisters at: 5) _: (calloutState floatRegisters at: 6) _: (calloutState floatRegisters at: 7)]. (self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector]. atomicType := self atomicTypeOf: calloutState ffiRetHeader. + ((atomicType >> 1) = (FFITypeSingleFloat >> 1) + or: [(calloutState ffiRetHeader bitAnd: FFIFlagPointer+FFIFlagStructure) = FFIFlagStructure + and: [self structIsHomogenousFloatArrayOfSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask) + typeSpec: (self cCoerce: (interpreterProxy firstIndexableField: calloutState ffiRetSpec) to: #'unsigned int *') + ofLength: (specSize := interpreterProxy byteSizeOf: calloutState ffiRetSpec) / (self sizeof: #'unsigned int')]]) ifTrue: + [floatRet d: (self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'struct dprr (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') - (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: - [atomicType = FFITypeSingleFloat - ifTrue: - [floatRet := self - dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5) with: (calloutState integerRegisters at: 6) + with: (calloutState integerRegisters at: 7)). - with: (calloutState integerRegisters at: 7)] - ifFalse: "atomicType = FFITypeDoubleFloat" - [floatRet := self - dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') - with: (calloutState integerRegisters at: 0) - with: (calloutState integerRegisters at: 1) - with: (calloutState integerRegisters at: 2) - with: (calloutState integerRegisters at: 3) - with: (calloutState integerRegisters at: 4) - with: (calloutState integerRegisters at: 5) - with: (calloutState integerRegisters at: 6) - with: (calloutState integerRegisters at: 7)]. "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. interpreterProxy ownVM: myThreadIndex. + atomicType = FFITypeDoubleFloat ifTrue: + [^interpreterProxy floatObjectOf: (floatRet d doubles at: 0)]. + atomicType = FFITypeSingleFloat ifTrue: + [^interpreterProxy floatObjectOf: (floatRet f floats at: 0)]. + "If the struct is a vector of floats then move float[2] to float[1], float[4] to float[2] and float[6] to float[3], + to pack the float data in the double fields. We can tell if the struct is composed of floats if its size is less + than the spec size, since the spec size is (1 + n fields) * 4 bytes, and the struct size is n fields * 4 bytes + for floats and n fields * 8 bytes for doubles. We can't access the spec post call because it may have moved." + specSize > calloutState structReturnSize ifTrue: + [floatRet f floats at: 1 put: (floatRet f floats at: 2). + floatRet f floats at: 2 put: (floatRet f floats at: 4). + floatRet f floats at: 3 put: (floatRet f floats at: 6)]. + ^self ffiReturnStruct: (self addressOf: floatRet) ofType: (self ffiReturnType: specOnStack) in: calloutState]. - ^interpreterProxy floatObjectOf: floatRet]. "If struct address used for return value, call is special" (self mustReturnStructOnStack: calloutState structReturnSize) ifTrue: [ intRet := 0. + self setReturnRegister: (self cCoerceSimple: calloutState limit to: #sqLong) "stack alloca'd struct" + andCall: (self cCoerceSimple: procAddr to: #sqLong) + withArgsArray: (self cCoerceSimple: (self addressOf: calloutState integerRegisters) to: #sqLong). - self setReturnRegister: (self cCoerceSimple: calloutState limit to: 'sqLong') "stack alloca'd struct" - andCall: (self cCoerceSimple: procAddr to: 'sqLong') - withArgsArray: (self cCoerceSimple: (self addressOf: calloutState integerRegisters) to: 'sqLong'). ] ifFalse: [ intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5) with: (calloutState integerRegisters at: 6) with: (calloutState integerRegisters at: 7). x1Ret := self getX1register. "Capture x1 immediately. No problem if unused" ]. "If struct returned in registers, place register values into calloutState integerRegisters" (calloutState structReturnSize > 0 and: [self returnStructInRegisters: calloutState]) ifTrue: ["Only 2 regs used in ARMv8/Aarch64 current" calloutState integerRegisters at: 0 put: intRet. "X0" calloutState integerRegisters at: 1 put: x1Ret]. "X1" "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. interpreterProxy ownVM: myThreadIndex. (calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: ["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. + ^self ffiReturnStruct: (((self returnStructInRegisters: calloutState) + ifTrue: [self addressOf: calloutState integerRegisters] + ifFalse: [calloutState limit])) + ofType: (self ffiReturnType: specOnStack) + in: calloutState]. - ^self ffiReturnStruct: (self addressOf: intRet) ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState! Item was changed: ----- Method: ThreadedARM64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') ----- ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState + - | availableRegisterSpace stackPartSize roundedSize | + "See IHI0055B_aapcs64.pdf sections 4.3.5 & 5.4.2 Stage C; we don't yet support HVA's" + (self structIsHomogenousFloatArrayOfSize: structSize typeSpec: argSpec ofLength: argSpecSize) + ifTrue: + [availableRegisterSpace := (NumFloatRegArgs - calloutState floatRegisterIndex) * self wordSize. + structSize <= availableRegisterSpace ifTrue: "Stage C, step C.2, all in floating-point registers (!!!!)" + [self + memcpy: (self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) to: #'void *') + _: pointer + _: structSize. + "Round structSize up and divide by 8 ( NB: _not_ 4 !!)" + calloutState floatRegisterIndex: calloutState floatRegisterIndex + (structSize + 7 bitShift: -3). + ^0]. + "Stage C, step C.3" + availableRegisterSpace := 0. + calloutState floatRegisterIndex: 8] + ifFalse: + [availableRegisterSpace := (NumIntRegArgs - calloutState integerRegisterIndex) * self wordSize]. - - availableRegisterSpace := (NumIntRegArgs - calloutState integerRegisterIndex) * self wordSize. stackPartSize := structSize. + availableRegisterSpace > 0 ifTrue: + [structSize <= availableRegisterSpace ifTrue:"all in integer registers" + [self + memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: #'void *') + _: pointer + _: structSize. + "Round structSize up and divide by 8 ( NB: _not_ 4 !!)" + calloutState integerRegisterIndex: calloutState integerRegisterIndex + (structSize + 7 bitShift: -3). + ^0]. + "If no previous co-processor candidate arg has already been pushed on the stack, then split the struct between registers and stack. + Otherwise push entire struct on stack." + calloutState currentArg = calloutState argVector + ifTrue: + [stackPartSize := structSize - availableRegisterSpace. + self + memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') + _: pointer + _: availableRegisterSpace] + ifFalse: + [availableRegisterSpace := 0]. + "Stage C, step C.11" + calloutState integerRegisterIndex: NumIntRegArgs]. - availableRegisterSpace > 0 - ifTrue: - [structSize <= availableRegisterSpace - ifTrue: - ["all in registers" - stackPartSize := 0. - self - memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') - _: pointer - _: structSize. - "Round structSize up and divide by 8 ( NB: _not_ 4 !!)" - calloutState integerRegisterIndex: calloutState integerRegisterIndex + (structSize + 3 bitShift: -3) ] - ifFalse: - ["If no previous co-processor candidate arg has already been pushed on the stack, then split the struct between registers and stack. - Otherwise push entire struct on stack." - calloutState currentArg = calloutState argVector - ifTrue: - [stackPartSize := structSize - availableRegisterSpace. - self - memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') - _: pointer - _: availableRegisterSpace] - ifFalse: - [availableRegisterSpace := 0]. - calloutState integerRegisterIndex: NumIntRegArgs]]. + stackPartSize > 0 ifTrue: + [roundedSize := stackPartSize + 3 bitClear: 3. + calloutState currentArg + roundedSize > calloutState limit ifTrue: + [^FFIErrorCallFrameTooBig]. + self memcpy: calloutState currentArg _: (self addressOf: ((self cCoerceSimple: pointer to: #'char *') at: availableRegisterSpace)) _: stackPartSize. + calloutState currentArg: calloutState currentArg + roundedSize]. - stackPartSize > 0 - ifTrue: - [roundedSize := stackPartSize + 3 bitClear: 3. - calloutState currentArg + roundedSize > calloutState limit ifTrue: - [^FFIErrorCallFrameTooBig]. - self memcpy: calloutState currentArg _: (self addressOf: ((self cCoerceSimple: pointer to: 'char *') at: availableRegisterSpace)) _: stackPartSize. - calloutState currentArg: calloutState currentArg + roundedSize]. ^0! Item was changed: ----- Method: ThreadedARM64FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') ----- ffiReturnStruct: longLongRetPtr ofType: ffiRetType in: calloutState "Create a structure return value from an external function call. The value has been stored in alloca'ed space pointed to by the calloutState or in the integer registers." | retOop retClass oop | retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType. retOop := interpreterProxy instantiateClass: retClass indexableSize: 0. self remapOop: retOop in: [oop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: calloutState structReturnSize]. self memcpy: (interpreterProxy firstIndexableField: oop) + _: longLongRetPtr - _: ((self returnStructInRegisters: calloutState) - ifTrue: [self addressOf: calloutState integerRegisters] - ifFalse: [calloutState limit]) _: calloutState structReturnSize. interpreterProxy storePointer: 0 ofObject: retOop withValue: oop. ^retOop! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>floats (in category 'translation support') ----- + floats + "Hack for floatRet in ffiCalloutTo:SpecOnStack:in:" + + "to make it disappear..." + ^0! Item was added: + ----- Method: ThreadedARM64FFIPlugin>>structIsHomogenousFloatArrayOfSize:typeSpec:ofLength: (in category 'marshalling') ----- + structIsHomogenousFloatArrayOfSize: structSize typeSpec: argSpec ofLength: argSpecSize + + | firstField typeOfFirstField | + (structSize <= (4 * (self sizeof: #double)) + and: [argSpecSize <= 5]) "header plus up to four fields" ifFalse: + [^false]. + typeOfFirstField := self atomicTypeOf: (firstField := argSpec at: 1). + (typeOfFirstField ~= FFITypeSingleFloat and: [typeOfFirstField ~= FFITypeDoubleFloat]) ifTrue: + [^false]. + 2 to: argSpecSize - 1 do: + [:idx| + firstField ~= (argSpec at: idx) ifTrue: + [^false]]. + ^true! Item was changed: ----- Method: ThreadedFFICalloutState class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ThreadedFFICalloutState struct." self instVarNames do: [:ivn| aBinaryBlock value: ivn value: (ivn caseOf: { ['argVector'] -> [#'char *']. ['currentArg'] -> [#'char *']. ['limit'] -> [#'char *']. + ['ffiArgSpec'] -> [#'unsigned int *']. "ffiArgSpecs are WordArrays" - ['ffiArgSpec'] -> [#'void *']. ['stringArgs'] -> [{#'char *'. '[MaxNumArgs]'}] } otherwise: [#sqInt])]! Item was changed: ----- Method: ThreadedFFIPlugin class>>preambleCCode (in category 'translation') ----- preambleCCode "For a source of builtin defines grep for builtin_define in a gcc release config directory. + See platforms/Cross/vm/sqCogStackAlignment.h for per-platform definitions for + STACK_ALIGN_BYTES MUST_ALIGN_STACK, getsp, et al." - See See platforms/Cross/vm/sqCogStackAlignment.h for per-platform definitions for - STACK_ALIGN_BYTES MUST_ALIGN_STACK et al." ^' #include "sqAssert.h" /* for assert */ #define ThreadedFFIPlugin 1 /* to filter-out unwanted declarations from sqFFI.h */ #include "sqFFI.h" /* for logging and surface functions */ #include "sqCogStackAlignment.h" /* for STACK_ALIGN_BYTES and getsp() */ #ifdef _MSC_VER # define alloca _alloca #endif + #if !!defined(setsp) && defined(__GNUC__) + # if defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) + # define setsp(spval) asm volatile ("movl %0,%%esp" : : "m"(spval)) + # elif defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64) + # define setsp(spval) asm volatile ("movq %0,%%rsp" : : "m"(spval)) - #if defined(__GNUC__) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__)) - # define setsp(sp) asm volatile ("movl %0,%%esp" : : "m"(sp)) - # elif defined(__GNUC__) && (defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64)) - # define setsp(sp) asm volatile ("movq %0,%%rsp" : : "m"(sp)) # elif defined(__arm64__) || defined(__aarch64__) || defined(ARM64) /* https://gcc.gnu.org/onlinedocs/gcc/Extended-Asm.html#Extended-Asm * http://infocenter.arm.com/help/index.jsp?topic=/com.arm.doc.den0024a/index.html */ + # define setsp(spval) asm volatile ("mov sp, %0" : : "r"(spval)) + # elif defined(__arm__) + # define setsp(spval) asm volatile ("ldr %%sp, %0" : : "m"(spval)) + # endif - # if __GNUC__ - # define getfp() ({ usqIntptr_t fp; \ - asm volatile ("mov x0, x29" : "=r"(x29) : ); \ - fp; }) - # define getsp() ({ usqIntptr_t sp; \ - asm volatile ("mov x0, sp" : "=r"(sp) : ); \ - sp; }) - # define setsp(sp) asm volatile ("ldr x16, %0 \n\t" "mov sp, x16" : : "m"(sp) ) - # endif - # elif defined(__GNUC__) && (defined(__arm__)) - # define setsp(sp) asm volatile ("ldr %%sp, %0" : : "m"(sp)) #endif #if !!defined(getsp) # define getsp() 0 #endif #if !!defined(setsp) # define setsp(ignored) 0 #endif #if !!defined(STACK_ALIGN_BYTES) # define STACK_ALIGN_BYTES 0 #endif /* !!defined(STACK_ALIGN_BYTES) */ /* For ABI that require stack alignment greater than natural word size */ #define MUST_ALIGN_STACK (STACK_ALIGN_BYTES > sizeof(void*)) #if defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) /* Both Mac OS X x86 and Win32 x86 return structs of a power of two in size * less than or equal to eight bytes in length in registers. Linux never does so. */ # if __linux__ # define WIN32_X86_STRUCT_RETURN 0 # else # define WIN32_X86_STRUCT_RETURN 1 # endif # if _WIN32 # define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1 # endif + #elif defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64) - # elif defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64) # if _WIN32 | _WIN64 # define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1 # endif #endif /* defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) */ #if !!defined(ALLOCA_LIES_SO_SETSP_BEFORE_CALL) # if defined(__MINGW32__) && !!defined(__clang__) && (__GNUC__ >= 3) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__)) /* * cygwin -mno-cygwin (MinGW) gcc 3.4.x''s alloca is a library routine that answers * %esp + xx, so the outgoing stack is offset by one or more word if uncorrected. * Grab the actual stack pointer to correct. */ # define ALLOCA_LIES_SO_SETSP_BEFORE_CALL 1 # else # define ALLOCA_LIES_SO_SETSP_BEFORE_CALL 0 # endif #endif /* !!defined(ALLOCA_LIES_SO_SETSP_BEFORE_CALL) */ #if !!defined(PLATFORM_API_USES_CALLEE_POPS_CONVENTION) # define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 0 #endif - /* This alignment stuff is a hack for integerAt:put:size:signed:/primitiveFFIIntegerAt[Put]. - * The assumption right now is that all processors support unaligned access. That only - * holds true for x86, x86-64 & ARMv6 & later. But this keeps us going until we can address - * it properly. - */ - #define unalignedShortAt(a) shortAt(a) - #define unalignedShortAtput(a,v) shortAtput(a,v) - #define unalignedLong32At(a) long32At(a) - #define unalignedLong32Atput(a,v) long32Atput(a,v) - #define unalignedLong64At(a) long64At(a) - #define unalignedLong64Atput(a,v) long64Atput(a,v) - /* The dispatchOn:in:with:with: generates an unwanted call on error. Just squash it. */ #define error(foo) 0 - #ifndef SQUEAK_BUILTIN_PLUGIN - /* but print assert failures. */ - void - warning(char *s) { /* Print an error message but don''t exit. */ - printf("\n%s\n", s); - } - #endif /* sanitize */ #ifdef SQUEAK_BUILTIN_PLUGIN # define EXTERN #else # define EXTERN extern #endif '! Item was changed: ----- Method: ThreadedFFIPlugin>>alignmentOfStructSpec:OfLength:StartingAt: (in category 'marshalling-struct') ----- alignmentOfStructSpec: specs OfLength: specSize StartingAt: indexPtr "Answer with the alignment requirement for a structure/union. Note that indexPtr is a pointer so as to be changed on return. On input, the index points to the structure header (the one with FFIFlagStructure + structSize). On output, the index points the the structure trailer (the FFIFlagStructure)." | spec byteAlignment thisAlignment | + + - - spec := specs at: (indexPtr at: 0). self assert: (spec bitAnd: FFIFlagPointer + FFIFlagAtomic + FFIFlagStructure) = FFIFlagStructure. byteAlignment := 1. [indexPtr at: 0 put: (indexPtr at: 0) + 1. (indexPtr at: 0) < specSize] whileTrue: [spec := specs at: (indexPtr at: 0). spec = FFIFlagStructure ifTrue: [^byteAlignment]. thisAlignment := (spec anyMask: FFIFlagPointer) ifTrue: [BytesPerWord] ifFalse: [(spec anyMask: FFIFlagStructure) ifTrue: [self alignmentOfStructSpec: specs OfLength: specSize StartingAt: indexPtr] ifFalse: [spec bitAnd: FFIStructSizeMask]]. byteAlignment := byteAlignment max: thisAlignment]. self assert: false. "should not reach here - because only ever called for sub-struct" ^byteAlignment! Item was changed: ----- Method: ThreadedFFIPlugin>>checkAlignmentOfStructSpec:OfLength:StartingAt: (in category 'marshalling-struct') ----- checkAlignmentOfStructSpec: specs OfLength: specSize StartingAt: startIndex "Check the alignment of a structure and return true if correctly aligned. If computed size = declared size, then the struct is assumed correctly aligned." | index spec computedSize fieldAlignment fieldSize declaredSize maxAlignment | + - index := startIndex. spec := specs at: index. self assert: (spec bitAnd: FFIFlagPointer + FFIFlagAtomic + FFIFlagStructure) = FFIFlagStructure. + (self isUnionSpec: specs OfLength: specSize StartingAt: index) ifTrue: + [^self checkAlignmentOfUnionSpec: specs OfLength: specSize StartingAt: startIndex]. - (self isUnionSpec: specs OfLength: specSize StartingAt: index) - ifTrue: - [^self checkAlignmentOfUnionSpec: specs OfLength: specSize StartingAt: startIndex]. declaredSize := spec bitAnd: FFIStructSizeMask. computedSize := 0. maxAlignment := 1. + [(index := index + 1) < specSize] whileTrue: + [spec := specs at: index. + spec = FFIFlagStructure ifTrue: + [^(computedSize - 1 bitOr: maxAlignment - 1) + 1 = declaredSize]. + (spec anyMask: FFIFlagPointer) + ifTrue: + [fieldSize := BytesPerWord. + fieldAlignment := fieldSize] + ifFalse: + [fieldSize := spec bitAnd: FFIStructSizeMask. + (spec anyMask: FFIFlagStructure) + ifTrue: + [(self checkAlignmentOfStructSpec: specs OfLength: specSize StartingAt: index) ifFalse: + [^false]. + fieldAlignment := self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: index put: [:v| index := v])] + ifFalse: [fieldAlignment := fieldSize]]. + "round to fieldAlignment" + maxAlignment := maxAlignment max: fieldAlignment. + computedSize := (computedSize - 1 bitOr: fieldAlignment - 1) + 1. + computedSize := computedSize + fieldSize]. - [index := index + 1. - index < specSize] - whileTrue: - [spec := specs at: index. - spec = FFIFlagStructure - ifTrue: [^(computedSize - 1 bitOr: maxAlignment - 1) + 1 = declaredSize]. - (spec anyMask: FFIFlagPointer) - ifTrue: - [fieldSize := BytesPerWord. - fieldAlignment := fieldSize] - ifFalse: - [fieldSize := spec bitAnd: FFIStructSizeMask. - (spec anyMask: FFIFlagStructure) - ifTrue: - [(self checkAlignmentOfStructSpec: specs OfLength: specSize StartingAt: index) - ifFalse: [^false]. - fieldAlignment := self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: index)] - ifFalse: [fieldAlignment := fieldSize]]. - "round to fieldAlignment" - maxAlignment := maxAlignment max: fieldAlignment. - computedSize := (computedSize - 1 bitOr: fieldAlignment - 1) + 1. - computedSize := computedSize + fieldSize]. ^(computedSize - 1 bitOr: maxAlignment - 1) + 1 = declaredSize! Item was changed: ----- Method: ThreadedFFIPlugin>>externalFunctionHasStackSizeSlot (in category 'symbol loading') ----- externalFunctionHasStackSizeSlot + - ^externalFunctionInstSize > ExternalFunctionStackSizeIndex! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiArgument:Spec:Class:in: (in category 'callout support') ----- ffiArgument: oop Spec: argSpec Class: argClass in: calloutState "Callout support. Prepare the given oop as argument. argSpec defines the compiled spec for the argument. argClass (if non-nil) defines the required (super)class for the argument." | valueOop oopClass isStruct nilOop | oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class (we'll need it)" nilOop := interpreterProxy nilObject. "Do the necessary type checks" + argClass = nilOop ifFalse: - argClass = nilOop ifFalse:[ "Type check 1: + Is the required class of the argument a general instance of ExternalStructure?" + [(interpreterProxy + includesBehavior: argClass + ThatOf: interpreterProxy classExternalStructure) ifFalse: + [^FFIErrorWrongType]. - Is the required class of the argument a subclass of ExternalStructure?" - (interpreterProxy includesBehavior: argClass - ThatOf: interpreterProxy classExternalStructure) - ifFalse:[^FFIErrorWrongType]. "Nope. Fail." "Type check 2: + Is the class of the argument a general instance of the required class?" + (nilOop = oop or: [interpreterProxy includesBehavior: oopClass ThatOf: argClass]) ifFalse: + [^FFIErrorCoercionFailed]]. + "Okay, we've passed the type check (so far)" - Is the class of the argument a subclass of required class?" - ((nilOop = oop) or:[interpreterProxy includesBehavior: oopClass ThatOf: argClass]) - ifFalse:[^FFIErrorCoercionFailed]. "Nope. Fail." - "Okay, we've passed the type check (so far)" - ]. + "Check if oopClass is a general instance of ExternalStructure. + If this is the case we'll work on its handle and not the actual oop." - "Check if oopClass is a subclass of ExternalStructure. - If this is the case we'll work on it's handle and not the actual oop." isStruct := false. (oop ~= nilOop and: [interpreterProxy isPointers: oop]) ifTrue: "#isPointers: will fail if oop is immediate so don't even attempt to use it" [isStruct := interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalStructure. (argClass = nilOop or: [isStruct]) ifFalse: [^FFIErrorCoercionFailed]]. "note: the test for #isPointers: above should speed up execution since no pointer type ST objects are allowed in external calls and thus if #isPointers: is true then the arg must be ExternalStructure to work. If it isn't then the code fails anyways so speed isn't an issue." "Determine valueOop (e.g., the actual oop to pass as argument)" + valueOop := isStruct + ifTrue: [interpreterProxy fetchPointer: 0 ofObject: oop] + ifFalse: [oop]. - isStruct - ifTrue:[valueOop := interpreterProxy fetchPointer: 0 ofObject: oop] - ifFalse:[valueOop := oop]. "Fetch and check the contents of the compiled spec" + (interpreterProxy isWords: argSpec) ifFalse: + [^FFIErrorWrongType]. + calloutState ffiArgSpecSize: (interpreterProxy byteSizeOf: argSpec) / (self sizeof: #'unsigned int'). + calloutState ffiArgSpecSize = 0 ifTrue: + [^FFIErrorWrongType]. + calloutState ffiArgSpec: (self cCoerce: (interpreterProxy firstIndexableField: argSpec) to: #'unsigned int *'). + calloutState ffiArgHeader: (calloutState ffiArgSpec at: 0). - (interpreterProxy isWords: argSpec) - ifFalse:[^FFIErrorWrongType]. - calloutState ffiArgSpecSize: (interpreterProxy slotSizeOf: argSpec). - calloutState ffiArgSpecSize = 0 ifTrue:[^FFIErrorWrongType]. - calloutState ffiArgSpec: (interpreterProxy firstIndexableField: argSpec). - calloutState ffiArgHeader: (interpreterProxy longAt: calloutState ffiArgSpec). "Do the actual preparation of the argument" "Note: Order is important since FFIFlagStructure + FFIFlagPointer is used to represent 'typedef void* VoidPointer' and VoidPointer really is *struct* not pointer." + (calloutState ffiArgHeader anyMask: FFIFlagStructure) ifTrue: "argument must be ExternalStructure" + [isStruct ifFalse: + [^FFIErrorCoercionFailed]. + (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue: + [^FFIErrorWrongType]. "bad combination" - (calloutState ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[ - "argument must be ExternalStructure" - isStruct ifFalse:[^FFIErrorCoercionFailed]. - (calloutState ffiArgHeader anyMask: FFIFlagAtomic) - ifTrue:[^FFIErrorWrongType]. "bad combination" ^self ffiPushStructureContentsOf: valueOop in: calloutState]. + (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifTrue: "no integers (or characters) for pointers please" + [(interpreterProxy isImmediate: oop) ifTrue: + [^FFIErrorIntAsPointer]. - (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[ - "no integers (or characters) for pointers please" - (interpreterProxy isImmediate: oop) - ifTrue:[^FFIErrorIntAsPointer]. "but allow passing nil pointer for any pointer type" + oop = nilOop ifTrue: + [^self ffiPushPointer: nil in: calloutState]. - oop = nilOop ifTrue:[^self ffiPushPointer: nil in: calloutState]. "argument is reference to either atomic or structure type" + (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue: + [isStruct ifTrue:"e.g., ExternalData" + [^self ffiAtomicStructByReference: oop Class: oopClass in: calloutState]. + ^self ffiAtomicArgByReference: oop Class: oopClass in: calloutState]. - (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[ - isStruct "e.g., ExternalData" - ifTrue:[^self ffiAtomicStructByReference: oop Class: oopClass in: calloutState] - ifFalse:[^self ffiAtomicArgByReference: oop Class: oopClass in: calloutState]. "********* NOTE: The above uses 'oop' not 'valueOop' (for ExternalData) ******" - ]. "Needs to be external structure here" + isStruct ifTrue: + [^self ffiPushPointerContentsOf: valueOop in: calloutState]. + ^FFIErrorCoercionFailed]. - isStruct ifFalse:[^FFIErrorCoercionFailed]. - ^self ffiPushPointerContentsOf: valueOop in: calloutState]. + (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue: "argument is atomic value" + [^self ffiArgByValue: valueOop in: calloutState]. + - (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[ - "argument is atomic value" - ^self ffiArgByValue: valueOop in: calloutState]. "None of the above - bad spec" ^FFIErrorWrongType! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState "Perform the callout, collect the result and and create the return value. If a threaded call, disown and own VM around the call. If there are floating-point arguments that are passed in registers then call a dummy function to load them. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:SpecOnStack:Flags:NumArgs:Args:AndTypes:" + - self subclassResponsibility! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiCreateIntegralResultOop:ofAtomicType:in: (in category 'callout support') ----- ffiCreateIntegralResultOop: retVal ofAtomicType: atomicType in: calloutState "Callout support. Return the appropriate oop for the given atomic type" | shift value mask byteSize | self assert: atomicType < FFITypeSingleFloat. 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 <= FFITypeSignedInt ifTrue: ["these are all generall integer returns" atomicType <= (BytesPerWord = 8 ifTrue: [FFITypeSignedInt] ifFalse: [FFITypeSignedShort]) ifTrue: ["byte/short. first extract partial word, then sign extend" shift := (BytesPerWord = 8 and: [atomicType >= FFITypeUnsignedInt]) 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:[interpreterProxy signedMachineIntegerFor: retVal] "signed return" ifFalse:[interpreterProxy positiveMachineIntegerFor: retVal]]. "unsigned return" "longlong, char" + (atomicType >> 1) = (FFITypeSignedLongLong >> 1) ifTrue: + [^(atomicType anyMask: 1) + ifTrue: [interpreterProxy signed64BitIntegerFor: retVal] "signed return" + ifFalse: [interpreterProxy positive64BitIntegerFor: retVal]]. + self cppIf: #SPURVM + ifTrue: [^interpreterProxy characterObjectOf: (retVal bitAnd: 16r3FFFFFFF)] + ifFalse: [^interpreterProxy characterObjectOf: (retVal bitAnd: 16rFF)]! - ^(atomicType >> 1) = (FFITypeSignedLongLong >> 1) - ifTrue: - [(atomicType anyMask: 1) - ifTrue:[interpreterProxy signed64BitIntegerFor: retVal] "signed return" - ifFalse:[interpreterProxy positive64BitIntegerFor: retVal]] - ifFalse: - [interpreterProxy characterObjectOf: (retVal bitAnd: 16rFF)]! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiPushPointerContentsOf:in: (in category 'marshalling') ----- ffiPushPointerContentsOf: oop in: calloutState "Push the contents of the given external structure" | ptrClass ptrAddress | ptrClass := interpreterProxy fetchClassOf: oop. ptrClass = interpreterProxy classExternalAddress ifTrue: [ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer. "Don't you dare to pass pointers into object memory" + (interpreterProxy isInMemory: ptrAddress asUnsignedIntegerPtr) ifTrue: - (interpreterProxy isInMemory: ptrAddress) ifTrue: [^FFIErrorInvalidPointer]. ^self ffiPushPointer: ptrAddress in: calloutState]. ptrClass = interpreterProxy classByteArray ifTrue: ["Since this involves passing the address of the first indexable field we need to fail the call if it is threaded and the object is young, since it may move during the call." self cppIf: COGMTVM ifTrue: [((calloutState callFlags anyMask: FFICallFlagThreaded) and: [interpreterProxy isYoung: oop]) ifTrue: [^PrimErrObjectMayMove negated]]. ptrAddress := interpreterProxy firstIndexableField: oop. ^self ffiPushPointer: ptrAddress in: calloutState]. (interpreterProxy includesBehavior: ptrClass ThatOf: interpreterProxy classAlien) ifTrue: [self cppIf: COGMTVM ifTrue: [((calloutState callFlags anyMask: FFICallFlagThreaded) and: [(self isDirectAlien: oop) and: [interpreterProxy isYoung: oop]]) ifTrue: [^PrimErrObjectMayMove negated]]. + ptrAddress := self cCoerce: (self startOfData: oop) to: #'void *'. - ptrAddress := self startOfData: oop. ^self ffiPushPointer: ptrAddress in: calloutState]. ^FFIErrorBadArg! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiPushStructureContentsOf:in: (in category 'marshalling-struct') ----- ffiPushStructureContentsOf: oop in: calloutState "Push the contents of the given external structure" | ptrClass ptrAddress | ptrClass := interpreterProxy fetchClassOf: oop. ptrClass = interpreterProxy classExternalAddress ifTrue: "ExternalAddress is bytes" [ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer. "There is no way we can make sure the structure is valid. But we can at least check for attempts to pass pointers to ST memory." + (interpreterProxy isInMemory: ptrAddress asUnsignedIntegerPtr) ifTrue: - (interpreterProxy isInMemory: ptrAddress) ifTrue: [^FFIErrorInvalidPointer]. ^self ffiPushStructure: ptrAddress ofSize: (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) typeSpec: calloutState ffiArgSpec ofLength: calloutState ffiArgSpecSize in: calloutState]. ptrClass = interpreterProxy classByteArray ifTrue: ["The following is a somewhat pessimistic test but I like being sure..." (interpreterProxy byteSizeOf: oop) = (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) ifFalse:[^FFIErrorStructSize]. ptrAddress := interpreterProxy firstIndexableField: oop. (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifFalse: "Since this involves passing the address of the first indexable field we need to fail the call if it is threaded and the object is young, since it may move during the call." [self cppIf: COGMTVM ifTrue: [((calloutState callFlags anyMask: FFICallFlagThreaded) and: [interpreterProxy isYoung: oop]) ifTrue: [^PrimErrObjectMayMove negated]]. ^self ffiPushStructure: ptrAddress ofSize: (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) typeSpec: calloutState ffiArgSpec ofLength: calloutState ffiArgSpecSize in: calloutState]. "If FFIFlagPointer + FFIFlagStructure is set use ffiPushPointer on the contents" (calloutState ffiArgHeader bitAnd: FFIStructSizeMask) = BytesPerWord ifFalse: [^FFIErrorStructSize]. ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer. + (interpreterProxy isInMemory: ptrAddress asUnsignedIntegerPtr) ifTrue: - (interpreterProxy isInMemory: ptrAddress) ifTrue: [^FFIErrorInvalidPointer]. ^self ffiPushPointer: ptrAddress in: calloutState]. ^FFIErrorBadArg! Item was changed: ----- Method: ThreadedFFIPlugin>>isUnionSpec:OfLength:StartingAt: (in category 'marshalling-struct') ----- isUnionSpec: specs OfLength: specSize StartingAt: startIndex "We can't easily distinguish union from structures with available flags. But we have a trick: a union should have one field size equal to its own size." | index spec unionSize thisSize | index := startIndex. spec := specs at: index. self assert: (spec bitAnd: FFIFlagPointer + FFIFlagAtomic + FFIFlagStructure) = FFIFlagStructure. unionSize := spec bitAnd: FFIStructSizeMask. [index := index + 1. index < specSize] whileTrue: [spec := specs at: index. spec = FFIFlagStructure ifTrue: [^false]. thisSize := spec bitAnd: FFIStructSizeMask. thisSize = unionSize ifTrue: [^true]. ((spec bitAnd: FFIFlagPointer + FFIFlagStructure) = FFIFlagStructure) ifTrue: ["Asking for alignment is a trick for skipping this sub structure/union" + self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: index put: [:v| index := v])]]. - self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: index)]]. ^false! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIDoubleAt (in category 'primitives') ----- primitiveFFIDoubleAt "Return a (signed or unsigned) n byte integer from the given byte offset." | byteOffset rcvr addr floatValue | byteOffset := interpreterProxy stackIntegerValue: 0. rcvr := interpreterProxy stackObjectValue: 1. interpreterProxy failed ifTrue:[^0]. addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8. addr = 0 ifTrue: [^interpreterProxy primitiveFail]. self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue). + interpreterProxy methodReturnFloat: floatValue - interpreterProxy pop: 2. - ^interpreterProxy pushFloat: floatValue ! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIDoubleAtPut (in category 'primitives') ----- primitiveFFIDoubleAtPut "Return a (signed or unsigned) n byte integer from the given byte offset." | byteOffset rcvr addr floatValue floatOop | floatOop := interpreterProxy stackValue: 0. (interpreterProxy isIntegerObject: floatOop) + ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to: #double] + ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to: #double]. - ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'double'] - ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'double']. byteOffset := interpreterProxy stackIntegerValue: 1. rcvr := interpreterProxy stackObjectValue: 2. interpreterProxy failed ifTrue:[^0]. addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8. addr = 0 ifTrue: [^interpreterProxy primitiveFail]. self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue). ^interpreterProxy pop: 3 thenPush: floatOop! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIFloatAt (in category 'primitives') ----- primitiveFFIFloatAt "Return a (signed or unsigned) n byte integer from the given byte offset." | byteOffset rcvr addr floatValue | byteOffset := interpreterProxy stackIntegerValue: 0. rcvr := interpreterProxy stackObjectValue: 1. interpreterProxy failed ifTrue:[^0]. addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4. addr = 0 ifTrue: [^interpreterProxy primitiveFail]. self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue). + interpreterProxy methodReturnFloat: floatValue! - interpreterProxy pop: 2. - ^interpreterProxy pushFloat: floatValue! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIFloatAtPut (in category 'primitives') ----- primitiveFFIFloatAtPut "Return a (signed or unsigned) n byte integer from the given byte offset." | byteOffset rcvr addr floatValue floatOop | floatOop := interpreterProxy stackValue: 0. (interpreterProxy isIntegerObject: floatOop) + ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to: #float] + ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to: #float]. - ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'float'] - ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'float']. byteOffset := interpreterProxy stackIntegerValue: 1. rcvr := interpreterProxy stackObjectValue: 2. interpreterProxy failed ifTrue:[^0]. addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4. addr = 0 ifTrue: [^interpreterProxy primitiveFail]. self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue). ^interpreterProxy pop: 3 thenPush: floatOop! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIFree (in category 'primitives') ----- primitiveFFIFree "Primitive. Free the object pointed to on the external heap." | addr oop ptr | oop := interpreterProxy stackObjectValue: 0. ((interpreterProxy fetchClassOf: oop) = interpreterProxy classExternalAddress and: [(interpreterProxy byteSizeOf: oop) = (self sizeof: #'sqIntptr_t')]) ifFalse: [^interpreterProxy primitiveFail]. ptr := interpreterProxy firstIndexableField: oop. addr := ptr at: 0. "Don't you dare to free Squeak's memory!!" (addr = 0 or: [(addr asUnsignedIntegerPtr bitAnd: (self sizeof: #'sqIntptr_t') - 1) ~= 0 + or: [interpreterProxy isInMemory: addr asUnsignedIntegerPtr]]) ifTrue: - or: [interpreterProxy isInMemory: addr]]) ifTrue: [^interpreterProxy primitiveFail]. self ffiFree: addr. ^ptr at: 0 put: 0 "cleanup"! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveStructureElementAlignment (in category 'primitives') ----- primitiveStructureElementAlignment "Answer the alignment of an element of an atomic type, or a structure, within a structure on the current platform." | typeCode alignment | + typeCode := interpreterProxy stackValue: 0. ((interpreterProxy isIntegerObject: typeCode) and: [((typeCode := interpreterProxy integerValueOf: typeCode) between: FFITypeUnsignedByte and: FFITypeDoubleFloat) or: [typeCode = FFIFlagStructure]]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. alignment := typeCode caseOf: { [FFITypeUnsignedByte] -> [self structOffsetOf: 'structByte *' atomicTypeCode: FFITypeUnsignedByte]. [FFITypeSignedByte] -> [self structOffsetOf: 'structByte *' atomicTypeCode: FFITypeUnsignedByte]. [FFITypeUnsignedShort] -> [self structOffsetOf: 'structShort *' atomicTypeCode: FFITypeUnsignedShort]. [FFITypeSignedShort] -> [self structOffsetOf: 'structShort *' atomicTypeCode: FFITypeUnsignedShort]. [FFITypeUnsignedInt] -> [self structOffsetOf: 'structInt *' atomicTypeCode: FFITypeUnsignedInt]. [FFITypeSignedInt] -> [self structOffsetOf: 'structInt *' atomicTypeCode: FFITypeUnsignedInt]. [FFITypeUnsignedLongLong] -> [self structOffsetOf: 'structLongLong *' atomicTypeCode: FFITypeUnsignedLongLong]. [FFITypeSignedLongLong] -> [self structOffsetOf: 'structLongLong *' atomicTypeCode: FFITypeUnsignedLongLong]. [FFITypeSingleFloat] -> [self structOffsetOf: 'structFloat *' atomicTypeCode: FFITypeSingleFloat]. [FFITypeDoubleFloat] -> [self structOffsetOf: 'structDouble *' atomicTypeCode: FFITypeDoubleFloat]. } otherwise: [self structOffsetOf: 'structStruct *' atomicTypeCode: FFIFlagStructure]. + ^interpreterProxy methodReturnInteger: alignment asUnsignedIntegerPtr! - ^interpreterProxy methodReturnInteger: alignment! Item was added: + ----- Method: ThreadedFFIPlugin>>unalignedLong32At: (in category 'primitive support') ----- + unalignedLong32At: index + "This alignment stuff is a hack for integerAt:put:size:signed:/primitiveFFIIntegerAt[Put]. + The assumption right now is that all processors support unaligned access. That only holds true + for x86, x86-64 & ARMv6 & later. But this keeps us going until we can address it properly." + + ^interpreterProxy long32At: index! Item was added: + ----- Method: ThreadedFFIPlugin>>unalignedLong32At:put: (in category 'primitive support') ----- + unalignedLong32At: index put: value + "This alignment stuff is a hack for integerAt:put:size:signed:/primitiveFFIIntegerAt[Put]. + The assumption right now is that all processors support unaligned access. That only holds true + for x86, x86-64 & ARMv6 & later. But this keeps us going until we can address it properly." + + ^interpreterProxy long32At: index put: value! Item was added: + ----- Method: ThreadedFFIPlugin>>unalignedLong64At: (in category 'primitive support') ----- + unalignedLong64At: index + "This alignment stuff is a hack for integerAt:put:size:signed:/primitiveFFIIntegerAt[Put]. + The assumption right now is that all processors support unaligned access. That only holds true + for x86, x86-64 & ARMv6 & later. But this keeps us going until we can address it properly." + + ^interpreterProxy long64At: index! Item was added: + ----- Method: ThreadedFFIPlugin>>unalignedLong64At:put: (in category 'primitive support') ----- + unalignedLong64At: index put: value + "This alignment stuff is a hack for integerAt:put:size:signed:/primitiveFFIIntegerAt[Put]. + The assumption right now is that all processors support unaligned access. That only holds true + for x86, x86-64 & ARMv6 & later. But this keeps us going until we can address it properly." + + ^interpreterProxy long64At: index put: value! Item was added: + ----- Method: ThreadedFFIPlugin>>unalignedShortAt: (in category 'primitive support') ----- + unalignedShortAt: index + "This alignment stuff is a hack for integerAt:put:size:signed:/primitiveFFIIntegerAt[Put]. + The assumption right now is that all processors support unaligned access. That only holds true + for x86, x86-64 & ARMv6 & later. But this keeps us going until we can address it properly." + + ^interpreterProxy shortAt: index! Item was added: + ----- Method: ThreadedFFIPlugin>>unalignedShortAt:put: (in category 'primitive support') ----- + unalignedShortAt: index put: value + "This alignment stuff is a hack for integerAt:put:size:signed:/primitiveFFIIntegerAt[Put]. + The assumption right now is that all processors support unaligned access. That only holds true + for x86, x86-64 & ARMv6 & later. But this keeps us going until we can address it properly." + + ^interpreterProxy shortAt: index put: value! Item was changed: ----- Method: ThreadedIA32FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" | myThreadIndex atomicType floatRet intRet | + - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState). (self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector]. atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)()'). "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. interpreterProxy ownVM: myThreadIndex. ^interpreterProxy floatObjectOf: floatRet]. intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)()'). "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. interpreterProxy ownVM: myThreadIndex. (calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: ["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiReturnStruct: (self addressOf: intRet) ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState! Item was changed: ----- Method: ThreadedX64SysVFFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" | myThreadIndex atomicType floatRet intRet sddRet sdiRet sidRet siiRet returnStructByValue registerType sRetPtr | + - returnStructByValue := (calloutState ffiRetHeader bitAnd: FFIFlagStructure + FFIFlagPointer + FFIFlagAtomic) = FFIFlagStructure. myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState). calloutState floatRegisterIndex > 0 ifTrue: [self load: (calloutState floatRegisters at: 0) Flo: (calloutState floatRegisters at: 1) a: (calloutState floatRegisters at: 2) t: (calloutState floatRegisters at: 3) R: (calloutState floatRegisters at: 4) e: (calloutState floatRegisters at: 5) g: (calloutState floatRegisters at: 6) s: (calloutState floatRegisters at: 7)]. (self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector]. atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5)] ifFalse: "atomicType = FFITypeDoubleFloat" [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5)]. interpreterProxy ownVM: myThreadIndex. ^interpreterProxy floatObjectOf: floatRet]. returnStructByValue ifFalse: [intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). interpreterProxy ownVM: myThreadIndex. (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState]. registerType := calloutState structReturnType. registerType caseOf: {[2r00] -> [sddRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnDD (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: sddRet) asVoidPointer]. [2r01] -> [sidRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnID (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: sidRet) asVoidPointer]. [2r10] -> [sdiRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnDI (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: sdiRet) asVoidPointer]. [2r11] -> [siiRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: siiRet) asVoidPointer]. [2r100] -> [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: floatRet) asVoidPointer]. [2r101] -> [intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: intRet) asVoidPointer]. [2r110] -> ["return a pointer to alloca'd memory" intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := intRet asVoidPointer "address of struct is returned in RAX, which also is calloutState limit"]} otherwise: [interpreterProxy ownVM: myThreadIndex. self ffiFail: FFIErrorWrongType. ^nil]. interpreterProxy ownVM: myThreadIndex. ^self ffiReturnStruct: sRetPtr ofType: (self ffiReturnType: specOnStack) in: calloutState! Item was changed: ----- Method: ThreadedX64SysVFFIPlugin>>registerType:ForStructSpecs:OfLength:StartingAt:ByteOffset:EightbyteOffset: (in category 'marshalling') ----- registerType: initialRegisterType ForStructSpecs: specs OfLength: specSize StartingAt: indexPtr ByteOffset: initialByteOffset EightbyteOffset: initialEightbyteOffset "Answer with a number characterizing the register type for passing a struct of size <= 16 bytes. On input, the index points to the structure header (the one with FFIFlagStructure + structSize) On output, the index points to the structure trailer (the FFIFlagStructure)." + + - - - | registerType eightbyteOffset byteOffset spec fieldSize alignment atomic subIndex isInt recurse subLevel | registerType := initialRegisterType. byteOffset := initialByteOffset. eightbyteOffset := initialEightbyteOffset. [indexPtr at: 0 put: (indexPtr at: 0) + 1. subLevel := 0. (indexPtr at: 0) < specSize] whileTrue: [spec := specs at: (indexPtr at: 0). isInt := false. recurse := false. spec = FFIFlagStructure "this marks end of structure/union" ifTrue: [subLevel = 0 ifTrue: [^registerType]. subLevel := subLevel - 1] ifFalse: [(spec anyMask: FFIFlagPointer) ifTrue: [fieldSize := BytesPerWord. alignment := fieldSize. isInt := true] ifFalse: [(spec bitAnd: FFIFlagStructure + FFIFlagAtomic) caseOf: {[FFIFlagStructure] -> [fieldSize := 0. subIndex := indexPtr at: 0. + alignment := self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: subIndex put: [:v| subIndex := v]). - alignment := self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: subIndex). recurse := self isUnionSpec: specs OfLength: specSize StartingAt: (indexPtr at: 0). recurse ifTrue: [fieldSize := spec bitAnd: FFIStructSizeMask] ifFalse: [subLevel := subLevel + 1]]. [FFIFlagAtomic] -> [fieldSize := spec bitAnd: FFIStructSizeMask. alignment := fieldSize. atomic := self atomicTypeOf: spec. isInt := (atomic >> 1) ~= (FFITypeSingleFloat >> 1)]} otherwise: ["invalid spec" ^-1]]. (byteOffset bitAnd: alignment - 1) = 0 ifFalse: ["this field requires alignment" byteOffset := (byteOffset bitClear: alignment - 1) + alignment]. byteOffset + fieldSize > 8 ifTrue: ["Not enough room on current Eightbyte for this field, skip to next one" eightbyteOffset := eightbyteOffset + 1. byteOffset := 0]. isInt ifTrue: ["If this eightbyte contains an int field, then we must use an int register" registerType := registerType bitOr: 1 << eightbyteOffset]. recurse ifTrue: ["union in structs require a recursive form, because we handle byteOffset/eightbyteOffset differently" registerType := self registerType: registerType ForUnionSpecs: specs OfLength: specSize StartingAt: indexPtr ByteOffset: byteOffset EightbyteOffset: eightbyteOffset]. "where to put the next field?" byteOffset := byteOffset + fieldSize. byteOffset >= 8 ifTrue: ["This eightbyte is full, skip to next one" eightbyteOffset := eightbyteOffset + 1. byteOffset := 0]]]. self assert: subLevel = 0. ^registerType! Item was changed: ----- Method: ThreadedX64SysVFFIPlugin>>registerType:ForUnionSpecs:OfLength:StartingAt:ByteOffset:EightbyteOffset: (in category 'marshalling') ----- registerType: initialRegisterType ForUnionSpecs: specs OfLength: specSize StartingAt: indexPtr ByteOffset: byteOffset EightbyteOffset: eightbyteOffset "Answer with a number characterizing the register type for passing a union of size <= 16 bytes. On input, the index points to the structure header (the one with FFIFlagStructure + structSize) On output, the index points to the structure trailer (the FFIFlagStructure)." + + - - | registerType spec atomic isInt recurse subLevel | registerType := initialRegisterType. [indexPtr at: 0 put: (indexPtr at: 0) + 1. subLevel := 0. (indexPtr at: 0) < specSize] whileTrue: [spec := specs at: (indexPtr at: 0). isInt := false. recurse := false. spec = FFIFlagStructure "this marks end of structure/union" ifTrue: [subLevel = 0 ifTrue: [^registerType]. subLevel := subLevel - 1] ifFalse: [(spec anyMask: FFIFlagPointer) ifTrue: [isInt := true] ifFalse: [(spec bitAnd: FFIFlagStructure + FFIFlagAtomic) caseOf: {[FFIFlagStructure] -> [recurse := (self isUnionSpec: specs OfLength: specSize StartingAt: (indexPtr at: 0))not. recurse ifFalse: [subLevel := subLevel + 1]]. [FFIFlagAtomic] -> [atomic := self atomicTypeOf: spec. isInt := (atomic >> 1) ~= (FFITypeSingleFloat >> 1)]} otherwise: ["invalid spec" ^-1]]. isInt ifTrue: ["If this eightbyte contains an int field, then we must use an int register" registerType := registerType bitOr: 1 << eightbyteOffset]. recurse ifTrue: ["struct in union require a recursive form, because we handle byteOffset/eightbyteOffset differently" registerType := self registerType: registerType ForStructSpecs: specs OfLength: specSize StartingAt: indexPtr ByteOffset: byteOffset EightbyteOffset: eightbyteOffset]]]. self assert: subLevel = 0. ^registerType! Item was changed: ----- Method: ThreadedX64SysVFFIPlugin>>registerTypeForStructSpecs:OfLength: (in category 'marshalling') ----- registerTypeForStructSpecs: specs OfLength: specSize "Answer with a number characterizing the register type for passing a struct of size <= 16 bytes. The bit at offset i of registerType is set to 1 if eightbyte at offset i is a int register (RAX ...) The bit at offset 2 indicates if there is a single eightbyte (struct size <= 8) * 2r00 for float float (XMM0 XMM1) * 2r01 for int float (RAX XMM0) * 2r10 for float int (XMM0 RAX) * 2r11 for int int (RAX RDX) * 2r100 for float (XMM0) * 2r101 for int (RAX) * 2r110 INVALID (not aligned) Beware, the bits must be read from right to left for decoding register type. Note: this method reconstructs the struct layout according to X64 alignment rules. Therefore, it will not work for packed struct or other exotic alignment." + - | index byteSize registerType | index := 0. byteSize := (specs at: index) bitAnd: FFIStructSizeMask. byteSize > 16 ifTrue: [^2r110]. (self checkAlignmentOfStructSpec: specs OfLength: specSize StartingAt: index) ifFalse: [^2r110]. registerType := byteSize <= 8 ifTrue: [2r100] ifFalse: [0]. ^(self isUnionSpec: specs OfLength: specSize StartingAt: 0) ifTrue: [ self registerType: registerType ForUnionSpecs: specs OfLength: specSize + StartingAt: (self addressOf: index put: [:v| index := v]) - StartingAt: (self addressOf: index) ByteOffset: 0 EightbyteOffset: 0 ] ifFalse: [ self registerType: registerType ForStructSpecs: specs OfLength: specSize + StartingAt: (self addressOf: index put: [:v| index := v]) - StartingAt: (self addressOf: index) ByteOffset: 0 EightbyteOffset: 0 ]! Item was changed: ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" | myThreadIndex atomicType floatRet intRet | + - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState). calloutState floatRegisterSignature > 0 ifTrue: [self load: (calloutState floatRegisters at: 0) Flo: (calloutState floatRegisters at: 1) atR: (calloutState floatRegisters at: 2) egs: (calloutState floatRegisters at: 3)]. (self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector]. atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3)] ifFalse: "atomicType = FFITypeDoubleFloat" [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3)]. "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. interpreterProxy ownVM: myThreadIndex. ^interpreterProxy floatObjectOf: floatRet]. intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3). "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. interpreterProxy ownVM: myThreadIndex. (calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: ["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiReturnStruct: (self addressOf: intRet) ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState! Item was changed: ----- Method: ThreadedX64Win64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') ----- ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState structSize <= 0 ifTrue: [^FFIErrorStructSize]. + "See https://docs.microsoft.com/en-us/cpp/build/x64-calling-convention?view=vs-2019" (structSize <= WordSize and: [(structSize bitAnd: structSize - 1) = 0 "a.k.a. structSize isPowerOfTwo"]) ifTrue: [| arg | self memcpy: (self addressOf: arg) _: pointer _: structSize. ^self ffiPushUnsignedLongLong: arg in: calloutState]. + "BUG!!!! This memory should be 16-byte aligned; Spur guarantees only 8-byte alignment." + self flag: #bug. - "For now just push the pointer; we should copy the struct to the outgoing stack frame!!!!" - self flag: 'quick hack'. ^self ffiPushPointer: pointer in: calloutState! Item was changed: ----- Method: VMPluginCodeGenerator>>isStructSend: (in category 'utilities') ----- isStructSend: aTSendNode "Answer if the argument aTSendNode is a send of a structure accessor. This is tricky. We want foo bar => foo->bar foo bar => foo.bar foo bar: expr => foo->bar = expr foo bar: expr => foo.bar = expr depending on whether foo is a struct or a pointer to a struct, but only if both foo is a struct type and bar is a field accessor. The tricky cases are self-sends within struct class methods. Here we need to distinguish between self-sends of ordinary methods from self sends of accessors. Override to avoid requiring that there be a struct accessor method for the selector." ^aTSendNode numArgs <= 1 + and: [(self isMacroSelector: aTSendNode selector) not + and: [(aTSendNode receiver structTargetKindIn: self) notNil]]! - and: [(aTSendNode receiver structTargetKindIn: self) notNil]! Item was added: + ----- Method: VMPluginCodeGenerator>>selectorReturnsPointerToStruct: (in category 'C code generator') ----- + selectorReturnsPointerToStruct: selector "" + | tMethod | + ^(tMethod := methods + at: selector + ifAbsent: + [apiMethods ifNotNil: + [apiMethods at: selector ifAbsent: []]]) notNil + and: [(VMStructType isTypePointerToStruct: tMethod returnType) + or: [(pluginClass isStructType: tMethod returnType) + and: [tMethod returnType last == $*]]]! Item was added: + ----- Method: VMPluginCodeGenerator>>selectorReturnsStruct: (in category 'C code generator') ----- + selectorReturnsStruct: selector "" + | tMethod | + ^(tMethod := methods + at: selector + ifAbsent: + [apiMethods ifNotNil: + [apiMethods at: selector ifAbsent: []]]) notNil + and: [(VMStructType isTypeStruct: tMethod returnType) + or: [(pluginClass isStructType: tMethod returnType) + and: [tMethod returnType last ~~ $*]]]! Item was changed: ----- Method: VMPluginCodeGenerator>>shouldGenerateAsInterpreterProxySend: (in category 'utilities') ----- shouldGenerateAsInterpreterProxySend: aSendNode "Answer if this send should be generated as interpreterProxy->foo or its moral equivalent (*). (*) since we now use function pointers declared in each external plugin we only indirect through interopreterProxy at plugin initialization. But we still have to find the set of sends a plugin uses." + (aSendNode receiver isVariable and: ['interpreterProxy' = aSendNode receiver name]) ifFalse: + [^false]. + (self isMacroSelector: aSendNode selector) ifTrue: + [^false]. - | selector | - (aSendNode receiver isVariable and: ['interpreterProxy' = aSendNode receiver name]) ifFalse: [^false]. - selector := aSendNode selector. - "baseHeaderSize, minSmallInteger et al are #defined in each VM's interp.h" - (VMBasicConstants mostBasicConstantSelectors includes: selector) ifTrue: [^false]. "Only include genuine InterpreterProxy methods, excluding things not understood by InterpreterProxy and things in its initialize, private and simulation protocols." + ^(#(initialize private #'simulation only') includes: (InterpreterProxy compiledMethodAt: aSendNode selector ifAbsent: [^false]) protocol) not! - ^(#(initialize private #'simulation only') includes: (InterpreterProxy compiledMethodAt: selector ifAbsent: [^false]) protocol) not! Item was changed: ----- Method: VMPluginCodeGenerator>>structTargetKindForDeclaration: (in category 'C code generator') ----- structTargetKindForDeclaration: decl "" ^(super structTargetKindForDeclaration: decl) ifNil: [pluginClass ifNotNil: + [| isPointer | + (pluginClass isStructType: ((isPointer := decl last == $*) + ifTrue: [decl allButLast withBlanksTrimmed] + ifFalse: [decl])) ifTrue: + [isPointer - [(pluginClass isStructType: (decl last = $* - ifTrue: [decl allButLast] - ifFalse: [decl]) withBlanksTrimmed) ifTrue: - [(decl indexOf: $*) > 0 ifTrue: [#pointer] ifFalse: [#struct]]]]! Item was changed: ----- Method: VMStructType class>>isTypePointerToStruct: (in category 'translation') ----- isTypePointerToStruct: type | index | + ^type isString - ^type notNil and: [(index := type indexOf: $*) > 0 and: [self ensureStructTypeCache anySatisfy: [:structType| (type beginsWith: structType) and: [index > structType size]]]]! From builds at travis-ci.org Sun Aug 30 01:12:31 2020 From: builds at travis-ci.org (Travis CI) Date: Sun, 30 Aug 2020 01:12:31 +0000 Subject: [Vm-dev] Still Failing: OpenSmalltalk/opensmalltalk-vm#2147 (Cog - 57d91d0) In-Reply-To: Message-ID: <5f4afcfee78a1_13fea8cdbabd0630bc@travis-tasks-c7fd69557-qprv6.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2147 Status: Still Failing Duration: 21 mins and 23 secs Commit: 57d91d0 (Cog) Author: Eliot Miranda Message: Merge pull request #515 from KenDickey/Cog vm-display-fbdev View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/03812efd76a0...57d91d0d2f97 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/722395326?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Sun Aug 30 02:20:51 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 30 Aug 2020 02:20:51 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2796.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2796.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2796 Author: eem Time: 29 August 2020, 7:20:43.067441 pm UUID: 28a85911-a957-43f5-9311-3434d5f7727c Ancestors: VMMaker.oscog-eem.2795 Fix a few storePointer:...withValue: objectMemory nilObject's to be storePointerUnchecked:. =============== Diff against VMMaker.oscog-eem.2795 =============== Item was changed: ----- Method: CoInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') ----- primitiveSuspend "Primitive. Suspend the receiver, aProcess such that it can be executed again by sending #resume. If the given process is not currently running, take it off its corresponding list. The primitive returns the list the receiver was previously on." | process myList | process := self stackTop. process = self activeProcess ifTrue: [| inInterpreter | "We're going to switch process, either to an interpreted frame or a machine code frame. To know whether to return or enter machine code we have to know from whence we came. We could have come from the interpreter, either directly or via a machine code primitive. We could have come from machine code. The instructionPointer tells us where from:" self pop: 1 thenPush: objectMemory nilObject. inInterpreter := instructionPointer >= objectMemory startOfMemory. self transferTo: self wakeHighestPriority from: CSSuspend. ^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]. myList := objectMemory fetchPointer: MyListIndex ofObject: process. "XXXX Fixme. We should really check whether myList is a kind of LinkedList or not but we can't easily so just do a quick check for nil which is the most common case." myList = objectMemory nilObject ifTrue: [^self primitiveFailFor: PrimErrBadReceiver]. "Alas in Spur we need a read barrier" (objectMemory isForwarded: myList) ifTrue: [myList := objectMemory followForwarded: myList. objectMemory storePointer: MyListIndex ofObject: process withValue: myList]. self removeProcess: process fromList: myList. self successful ifTrue: + [objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject. - [objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject. self pop: 1 thenPush: myList]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveNewMethod (in category 'compiled methods') ----- primitiveNewMethod | header bytecodeCount class size theMethod literalCount | header := self stackTop. bytecodeCount := self stackValue: 1. ((objectMemory isIntegerObject: header) and: [(objectMemory isIntegerObject: bytecodeCount) and: [(bytecodeCount := objectMemory integerValueOf: bytecodeCount) >= 0]]) ifFalse: [self primitiveFailFor: PrimErrBadArgument. ^self]. class := self stackValue: 2. literalCount := objectMemory literalCountOfMethodHeader: header. size := literalCount + LiteralStart * objectMemory bytesPerOop + bytecodeCount. objectMemory hasSpurMemoryManagerAPI ifTrue: [theMethod := objectMemory instantiateCompiledMethodClass: class indexableSize: size. theMethod ifNil: [self primitiveFailFor: ((objectMemory isCompiledMethodFormat: (objectMemory instSpecOfClass: class)) ifTrue: [PrimErrNoMemory] ifFalse: [PrimErrBadReceiver]). ^self]] ifFalse: [theMethod := objectMemory instantiateClass: class indexableSize: size]. objectMemory storePointerUnchecked: HeaderIndex ofObject: theMethod withValue: header. 1 to: literalCount do: + [:i | objectMemory storePointerUnchecked: i ofObject: theMethod withValue: objectMemory nilObject]. - [:i | objectMemory storePointer: i ofObject: theMethod withValue: objectMemory nilObject]. self pop: 3 thenPush: theMethod! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSuspend (in category 'process primitives') ----- primitiveSuspend "Primitive. Suspend the receiver, aProcess such that it can be executed again by sending #resume. If the given process is not currently running, take it off its corresponding list. The primitive returns the list the receiver was previously on." | process myList | process := self stackTop. process = self activeProcess ifTrue: [self pop: 1 thenPush: objectMemory nilObject. ^self transferTo: self wakeHighestPriority]. myList := objectMemory fetchPointer: MyListIndex ofObject: process. "XXXX Fixme. We should really check whether myList is a kind of LinkedList or not but we can't easily so just do a quick check for nil which is the most common case." myList = objectMemory nilObject ifTrue: [^self primitiveFailFor: PrimErrBadReceiver]. "Alas in Spur we need a read barrier" (objectMemory isForwarded: myList) ifTrue: [myList := objectMemory followForwarded: myList. objectMemory storePointer: MyListIndex ofObject: process withValue: myList]. self removeProcess: process fromList: myList. self successful ifTrue: + [objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject. - [objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject. self pop: 1 thenPush: myList]! Item was changed: ----- Method: StackInterpreter>>removeProcess:fromList: (in category 'process primitive support') ----- removeProcess: aProcess fromList: aList "Remove a given process from a linked list. May fail if aProcess is not on the list." | firstLink lastLink nextLink tempLink | self deny: (objectMemory isForwarded: aProcess). self deny: (objectMemory isForwarded: aList). firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aList. lastLink := objectMemory fetchPointer: LastLinkIndex ofObject: aList. self deny: (objectMemory isForwarded: firstLink). self deny: (objectMemory isForwarded: lastLink). aProcess = firstLink ifTrue: [nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess. self deny: (objectMemory isForwarded: nextLink). objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink. aProcess = lastLink ifTrue: [objectMemory storePointerUnchecked: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]] ifFalse: [tempLink := firstLink. [self deny: (objectMemory isForwarded: tempLink). tempLink = objectMemory nilObject ifTrue: [self primitiveFail. ^self]. nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink. nextLink = aProcess] whileFalse: [tempLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink]. nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess. objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink. aProcess = lastLink ifTrue: [objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink]]. + objectMemory storePointerUnchecked: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject! - objectMemory storePointer: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSignalAtMilliseconds (in category 'system control primitives') ----- primitiveSignalAtMilliseconds "Cause the time semaphore, if one has been registered, to be signalled when the microsecond clock is greater than or equal to the given tick value. A tick value of zero turns off timer interrupts." | msecsObj msecs deltaMsecs sema limit | msecsObj := self stackTop. sema := self stackValue: 1. msecs := self positive32BitValueOf: msecsObj. self successful ifTrue: [(objectMemory isSemaphoreOop: sema) ifTrue: [objectMemory splObj: TheTimerSemaphore put: sema. deltaMsecs := msecs - (self ioMSecs bitAnd: MillisecondClockMask). limit := MillisecondClockMask >> 1. "Handle a roll-over that could happen in between image invocation of ioMSecs and this invocation. This will limit the maximum relative duration to MillisecondClockMask/2, about 3 days currently. Every delay longer than that limit may lead to undefined behavior (shorten delay, or no delay at all)" deltaMsecs > limit ifTrue: [deltaMsecs := deltaMsecs - MillisecondClockMask]. nextWakeupUsecs := deltaMsecs > 0 ifTrue: [self ioUTCMicroseconds + (deltaMsecs * 1000)] ifFalse: [self ioUTCMicroseconds]. ^self pop: 2]. sema = objectMemory nilObject ifTrue: [objectMemory + storePointerUnchecked: TheTimerSemaphore - storePointer: TheTimerSemaphore ofObject: objectMemory specialObjectsOop withValue: objectMemory nilObject. nextWakeupUsecs := 0. ^self pop: 2]]. self primitiveFailFor: PrimErrBadArgument! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSignalAtUTCMicroseconds (in category 'system control primitives') ----- primitiveSignalAtUTCMicroseconds "Cause the time semaphore, if one has been registered, to be signalled when the microsecond clock is greater than or equal to the given tick value. A tick value of zero turns off timer interrupts." | usecsObj sema usecs | usecsObj := self stackTop. sema := self stackValue: 1. usecs := self positive64BitValueOf: usecsObj. self successful ifTrue: [(objectMemory isSemaphoreOop: sema) ifTrue: [objectMemory splObj: TheTimerSemaphore put: sema. nextWakeupUsecs := usecs. ^self pop: 2]. sema = objectMemory nilObject ifTrue: [objectMemory + storePointerUnchecked: TheTimerSemaphore - storePointer: TheTimerSemaphore ofObject: objectMemory specialObjectsOop withValue: objectMemory nilObject. nextWakeupUsecs := 0. ^self pop: 2]]. self primitiveFailFor: PrimErrBadArgument! From noreply at github.com Sun Aug 30 02:31:20 2020 From: noreply at github.com (Eliot Miranda) Date: Sat, 29 Aug 2020 19:31:20 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 671bcf: CogVM source as per VMMaker.oscog-eem.2796 Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 671bcff621d1ba87cf868a7f1a0c24fdbcfd020f https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/671bcff621d1ba87cf868a7f1a0c24fdbcfd020f Author: Eliot Miranda Date: 2020-08-29 (Sat, 29 Aug 2020) Changed paths: M nsspur64src/vm/cogit.h M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c M platforms/Cross/plugins/IA32ABI/x64win64abicc.c M scripts/revertIfEssentiallyUnchanged M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spurlowcodestack64src/vm/gcc3x-interp.c M spurlowcodestack64src/vm/interp.c M spurlowcodestacksrc/vm/gcc3x-interp.c M spurlowcodestacksrc/vm/interp.c M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstack64src/vm/validImage.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M spurstacksrc/vm/validImage.c M src/plugins/B2DPlugin/B2DPlugin.c M src/plugins/FilePlugin/FilePlugin.c M src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c M src/plugins/SqueakFFIPrims/ARM64FFIPlugin.c M src/plugins/SqueakFFIPrims/IA32FFIPlugin.c M src/plugins/SqueakFFIPrims/X64SysVFFIPlugin.c M src/plugins/SqueakFFIPrims/X64Win64FFIPlugin.c M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c M stacksrc/vm/gcc3x-interp.c M stacksrc/vm/interp.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.2796 Interpreter: Fix a few storePointer:...withValue: objectMemory nilObject's to be storePointerUnchecked:. ThreadedARM64Plugin: Implement support for Homogenous Float Arrays (HVAs, structs with up to four float fields, or up to four double fields). These are passed and returned in floating-point argument registers, on call if sufficient are available. To implement this the ThreadedARM64Plugin uses a union of a struct containing four doubles, and a struct containing eight floats. All float/double/HVA returns are handled by a call that expects a struct of four doubles. Hence Slang changes are needed (see below) to allow the struct to be conveniently defined with local methods. This fixes about five test cases in the FFI tests. Mark all methods required to be inlined to be in the same function as the alloca as inline: #always. Hence their code will only occur inlined, not a second time in an unused function. Tidy up, pulling the unaligned accessor macros out of the preamble and explicitly into methods, whether Slang has a chance to generate code correctly given their presence. Also make sure that all references to a type spec are typed as unsigned int/unsigned int *, including the callout state's ffiArgSpec. Fix a warning by typing InterpreterProxy>>characterObjectOf:'s argument as int to agree with sqVirtualMachine.h. Slang: Fix several issues with inlining and type inferrence to support the above ThreadedARM64Plugin fixes. Distinguish macros from struct accessors; previously isStructSend: could be confused. Make sure that structTargetKindForDeclaration: answers #pointer only for types endign with a *; previously it could be confused by e.g. a struct containing pointers. Make isTypePointerToStruct: more robust, answering false for anything that isn't a string and then analysing the string. emitCCodeAsFieldReferenceOn:level:generator: must also check for shouldGenerateAsInterpreterProxySend:. tryToInlineMethodsIn: must push the current method's declarations onto the scope stack to allow proper type inferrence while inlining. Since these changes now allow e.g. a structure method to be inlined, extend node:typeCompatibleWith:inliningInto:in: to inline such arguments; it needs to take the address of the argument to derive the lined pointer to the actual argument. From builds at travis-ci.org Sun Aug 30 02:52:21 2020 From: builds at travis-ci.org (Travis CI) Date: Sun, 30 Aug 2020 02:52:21 +0000 Subject: [Vm-dev] Still Failing: OpenSmalltalk/opensmalltalk-vm#2148 (Cog - 671bcff) In-Reply-To: Message-ID: <5f4b14649c9f0_13ff6c1fd52441539fc@travis-tasks-c7fd69557-jn4v5.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2148 Status: Still Failing Duration: 20 mins and 20 secs Commit: 671bcff (Cog) Author: Eliot Miranda Message: CogVM source as per VMMaker.oscog-eem.2796 Interpreter: Fix a few storePointer:...withValue: objectMemory nilObject's to be storePointerUnchecked:. ThreadedARM64Plugin: Implement support for Homogenous Float Arrays (HVAs, structs with up to four float fields, or up to four double fields). These are passed and returned in floating-point argument registers, on call if sufficient are available. To implement this the ThreadedARM64Plugin uses a union of a struct containing four doubles, and a struct containing eight floats. All float/double/HVA returns are handled by a call that expects a struct of four doubles. Hence Slang changes are needed (see below) to allow the struct to be conveniently defined with local methods. This fixes about five test cases in the FFI tests. Mark all methods required to be inlined to be in the same function as the alloca as inline: #always. Hence their code will only occur inlined, not a second time in an unused function. Tidy up, pulling the unaligned accessor macros out of the preamble and explicitly into methods, whether Slang has a chance to generate code correctly given their presence. Also make sure that all references to a type spec are typed as unsigned int/unsigned int *, including the callout state's ffiArgSpec. Fix a warning by typing InterpreterProxy>>characterObjectOf:'s argument as int to agree with sqVirtualMachine.h. Slang: Fix several issues with inlining and type inferrence to support the above ThreadedARM64Plugin fixes. Distinguish macros from struct accessors; previously isStructSend: could be confused. Make sure that structTargetKindForDeclaration: answers #pointer only for types endign with a *; previously it could be confused by e.g. a struct containing pointers. Make isTypePointerToStruct: more robust, answering false for anything that isn't a string and then analysing the string. emitCCodeAsFieldReferenceOn:level:generator: must also check for shouldGenerateAsInterpreterProxySend:. tryToInlineMethodsIn: must push the current method's declarations onto the scope stack to allow proper type inferrence while inlining. Since these changes now allow e.g. a structure method to be inlined, extend node:typeCompatibleWith:inliningInto:in: to inline such arguments; it needs to take the address of the argument to derive the lined pointer to the actual argument. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/57d91d0d2f97...671bcff621d1 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/722407430?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Mon Aug 31 01:18:09 2020 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 31 Aug 2020 01:18:09 0000 Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.2797.mcz Message-ID: Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2797.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2797 Author: eem Time: 30 August 2020, 6:17:59.909283 pm UUID: 84f54ca7-0a17-408a-9fc5-fb30a1ac6c6f Ancestors: VMMaker.oscog-eem.2796 Plugins: Squash a few C compiler warnings =============== Diff against VMMaker.oscog-eem.2796 =============== Item was changed: ----- Method: DeflatePlugin>>sendBlock:with:with:with: (in category 'encoding') ----- sendBlock: literalStream with: distanceStream with: litTree with: distTree "Require: zipCollection, zipCollectionSize, zipPosition, zipBitBuf, zipBitPos. " | oop litPos litLimit litArray distArray lit dist sum llBitLengths llCodes distBitLengths distCodes code extra litBlCount distBlCount | + "must be signed" oop := interpreterProxy fetchPointer: 0 ofObject: literalStream. litPos := interpreterProxy fetchInteger: 1 ofObject: literalStream. litLimit := interpreterProxy fetchInteger: 2 ofObject: literalStream. (litPos <= litLimit and: [(interpreterProxy isBytes: oop) and: [litLimit <= (interpreterProxy byteSizeOf: oop)]]) ifFalse: [^interpreterProxy primitiveFail]. litArray := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 0 ofObject: distanceStream. ((interpreterProxy isWords: oop) and: [litLimit <= (interpreterProxy slotSizeOf: oop) and: [(interpreterProxy fetchInteger: 1 ofObject: distanceStream) = litPos and: [(interpreterProxy fetchInteger: 2 ofObject: distanceStream) = litLimit]]]) ifFalse: [^interpreterProxy primitiveFail]. distArray := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 0 ofObject: litTree. (interpreterProxy isWords: oop) ifFalse: [^interpreterProxy primitiveFail]. litBlCount := interpreterProxy slotSizeOf: oop. llBitLengths := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 1 ofObject: litTree. ((interpreterProxy isWords: oop) and: [litBlCount = (interpreterProxy slotSizeOf: oop)]) ifFalse: [^interpreterProxy primitiveFail]. llCodes := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 0 ofObject: distTree. (interpreterProxy isWords: oop) ifFalse: [^interpreterProxy primitiveFail]. distBlCount := interpreterProxy slotSizeOf: oop. distBitLengths := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 1 ofObject: distTree. ((interpreterProxy isWords: oop) and: [distBlCount = (interpreterProxy slotSizeOf: oop)]) ifFalse: [^interpreterProxy primitiveFail]. distCodes := interpreterProxy firstIndexableField: oop. self nextZipBits: 0 put: 0. "Flush pending bits if necessary" sum := 0. [litPos < litLimit and:[zipPosition + 4 < zipCollectionSize]] whileTrue:[ lit := litArray at: litPos. dist := distArray at: litPos. litPos := litPos + 1. dist = 0 ifTrue:["literal" sum := sum + 1. lit < litBlCount ifFalse:[^interpreterProxy primitiveFail]. self nextZipBits: (llBitLengths at: lit) put: (llCodes at: lit). ] ifFalse:["match" sum := sum + lit + DeflateMinMatch. + "eem 8/30/2020 Can't happen; litArray has type unsigned char *, lit unsigned char. Leaving this in causes a C compiler warning." + false ifTrue: [lit < 256 ifFalse:[^interpreterProxy primitiveFail]]. - lit < 256 ifFalse:[^interpreterProxy primitiveFail]. code := zipMatchLengthCodes at: lit. code < litBlCount ifFalse:[^interpreterProxy primitiveFail]. self nextZipBits: (llBitLengths at: code) put: (llCodes at: code). extra := zipExtraLengthBits at: code - 257. extra = 0 ifFalse:[ lit := lit - (zipBaseLength at: code - 257). self nextZipBits: extra put: lit]. dist := dist - 1. dist < 16r8000 ifFalse:[^interpreterProxy primitiveFail]. dist < 256 ifTrue:[code := zipDistanceCodes at: dist] ifFalse:[code := zipDistanceCodes at: 256 + (dist >> 7)]. code < distBlCount ifFalse:[^interpreterProxy primitiveFail]. self nextZipBits: (distBitLengths at: code) put: (distCodes at: code). extra := zipExtraDistanceBits at: code. extra = 0 ifFalse:[ dist := dist - (zipBaseDistance at: code). self nextZipBits: extra put: dist]. ]. ]. interpreterProxy failed ifTrue:[^nil]. interpreterProxy storeInteger: 1 ofObject: literalStream withValue: litPos. interpreterProxy storeInteger: 1 ofObject: distanceStream withValue: litPos. ^sum! Item was changed: ----- Method: SocketPlugin>>netAddressToInt: (in category 'primitives') ----- netAddressToInt: ptrToByteArray "Convert the given internet network address (represented as a four-byte ByteArray) into a 32-bit integer. Fail if the given ptrToByteArray does not appear to point to a four-byte ByteArray." + | sz | + - sz := interpreterProxy byteSizeOf: ptrToByteArray cPtrAsOop. + sz = 4 ifFalse: [^interpreterProxy primitiveFail]. - sz = 4 ifFalse: [^ interpreterProxy primitiveFail]. ^ (ptrToByteArray at: 3 ) + ((ptrToByteArray at: 2) <<8) + ((ptrToByteArray at: 1) <<16) + ((ptrToByteArray at: 0) <<24)! Item was changed: ----- Method: SocketPlugin>>socketRecordSize (in category 'primitives') ----- socketRecordSize + "Answer the size of a Smalltalk socket record in bytes." + + ^self sizeof: #SQSocket! - "Return the size of a Smalltalk socket record in bytes." - - ^ self sizeof: #SQSocket! Item was changed: ----- Method: SocketPlugin>>socketValueOf: (in category 'primitives') ----- socketValueOf: socketOop "Answer a pointer to the first byte of of the socket record within the given Smalltalk object, or nil if socketOop is not a socket record." + ^((interpreterProxy isBytes: socketOop) and: [(interpreterProxy byteSizeOf: socketOop) = self socketRecordSize]) ifTrue: [self cCoerce: (interpreterProxy firstIndexableField: socketOop) to: #SocketPtr] ifFalse: [interpreterProxy primitiveFailFor: PrimErrBadArgument. nil]! From noreply at github.com Mon Aug 31 01:23:55 2020 From: noreply at github.com (Eliot Miranda) Date: Sun, 30 Aug 2020 18:23:55 -0700 Subject: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] 16ffd5: CogVM source as per VMMaker.oscog-eem.2797 Message-ID: Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 16ffd5b3c4c6e48968277e40543ca1f96b984473 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/16ffd5b3c4c6e48968277e40543ca1f96b984473 Author: Eliot Miranda Date: 2020-08-30 (Sun, 30 Aug 2020) Changed paths: M build.macos32x86/common/Makefile.flags M build.macos32x86/common/Makefile.rules M build.macos64ARMv8/common/Makefile.flags M build.macos64ARMv8/common/Makefile.rules M build.macos64x64/common/Makefile.flags M build.macos64x64/common/Makefile.rules M src/plugins/SocketPlugin/SocketPlugin.c M src/plugins/ZipPlugin/ZipPlugin.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.2797 Plugins: Squash a few C compiler warnings from the SocketPlugin and ZipPlugin. Eliminate the -fobjc-weak unused command line arg warning for MacOS builds. From builds at travis-ci.org Mon Aug 31 01:45:20 2020 From: builds at travis-ci.org (Travis CI) Date: Mon, 31 Aug 2020 01:45:20 +0000 Subject: [Vm-dev] Still Failing: OpenSmalltalk/opensmalltalk-vm#2149 (Cog - 16ffd5b) In-Reply-To: Message-ID: <5f4c563072254_13fb5c5cd75fc6962@travis-tasks-9f4b46d58-rqqvf.mail> Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2149 Status: Still Failing Duration: 20 mins and 52 secs Commit: 16ffd5b (Cog) Author: Eliot Miranda Message: CogVM source as per VMMaker.oscog-eem.2797 Plugins: Squash a few C compiler warnings from the SocketPlugin and ZipPlugin. Eliminate the -fobjc-weak unused command line arg warning for MacOS builds. View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/671bcff621d1...16ffd5b3c4c6 View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/722594147?utm_medium=notification&utm_source=email -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&utm_medium=notification&utm_source=email. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notification&utm_source=email. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications. -------------- next part -------------- An HTML attachment was scrubbed... URL: From florin.mateoc at gmail.com Mon Aug 31 14:30:03 2020 From: florin.mateoc at gmail.com (Florin Mateoc) Date: Mon, 31 Aug 2020 10:30:03 -0400 Subject: [Vm-dev] questions about a couple of primitives Message-ID: Hi, I had some unexpected results while looking at some primitives in the system, and I wanted to ask if they are expected/intentional: 1. 'ab' instVarAt: 1 => 97 (and 'ab' instVarAt: 2 => 98) I would have thought that #instVarAt: has pointer granularity, so I am curious if the observed behavior is an accident or intentional (and maybe even used somewhere) 2. | o | o := Object new. (WeakArray with: o) pointsTo: o => true I thought the main use case for #pointsTo: was to find hard references (e.g. for chasing memory leaks). The current behavior actually makes that use case a little more difficult to implement, since you have to special case weak references. When would one be interested in finding weak references? 3. The comment and the primitive used in #ensure: and #ifCurtailed: are the same, but the primitive failure code is different - the one for #ifCurtailed seems buggy, it never evaluates the argument None of the above are critical, but I am curious about them. Thank you in advance for any clarifications, Florin -------------- next part -------------- An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Mon Aug 31 19:42:13 2020 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Mon, 31 Aug 2020 12:42:13 -0700 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: Hi Florin, On Mon, Aug 31, 2020 at 7:30 AM Florin Mateoc wrote: > > Hi, > > I had some unexpected results while looking at some primitives in the > system, and I wanted to ask if they are expected/intentional: > > 1. 'ab' instVarAt: 1 => 97 (and 'ab' instVarAt: 2 => 98) > I would have thought that #instVarAt: has pointer granularity, so I am > curious if the observed behavior is an accident or intentional (and maybe > even used somewhere) > Since a ByteString's indexed inst vars are bytes this is as expected. What would you have expected? Smalltalk-80 has always behaved this way. There is a little more to this story. In Spur, instVarAt:[put:] is actually implemented by a new primitive slotAt:[put:]. Why? Spur has a lazy become scheme which means that become is implemented by morphing objects into forwarders to copies of objects. So if a become: b, then the system allocated copies of a and b, say a' and b', and morphs a into a forwarder to b', and b into a forwarder to a'. Forwarders are followed lazily, either when a message is sent to a forwarder or when a primitive encounters a forwarder somewhere within the objects it consumes. When a primitive fails the VM scans the input arguments to a depth specific to the primitive and if it finds references to forwarders, fixes them up to point to the targets of the forwarders, and retries the primitive. The old implementation of instVarAt:[put:] had primities that failed for indexes beyond the named instance variables, and handled indexed inst vars in primitive failure code: Object>>instVarAt: index "Primitive. Answer a fixed variable in an object. The numbering of the variables corresponds to the named instance variables. Fail if the index is not an Integer or is not the index of a fixed variable. Essential. See Object documentation whatIsAPrimitive." "Access beyond fixed variables." ^self basicAt: index - self class instSize Chris Muller uses instVarAt:[put:] on large arrays in his Magma database. He was noticing a severe slow down in Magma on Spur because instVarAt:[put:] was failing, the entire Array was being scanned for forwarders, and then the primitive actually failed and the basicAt:put: ran. The solution to this was to replace primitives 73 & 74 with the new slotAt:[put:] primitives 173 & 174. Now the primitive does not fail, and performance is restored (and much improved because Spur is faster). > 2. | o | o := Object new. (WeakArray with: o) pointsTo: o => true > I thought the main use case for #pointsTo: was to find hard references > (e.g. for chasing memory leaks). The current behavior actually makes that > use case a little more difficult to implement, since you have to special > case weak references. When would one be interested in finding weak > references? > I can't answer this. The design decision was made a whole ago. It would be easy to add pointsStronglyTo: and implement that correctly. Remember that references from named inst vars of weak objects are strong references. Only references from indexed inst vars of weak objects are weak. > 3. The comment and the primitive used in #ensure: and #ifCurtailed: are > the same, but the primitive failure code is different - the one for > #ifCurtailed seems buggy, it never evaluates the argument > Ah, this is a neat hack. The primitive numbers are not actually primitives, These primitives always fail, and the blocks are evaluated with the valueNoContextSwitch send in the method body. Instead the primitive numbers are used by the VM to mark the activations of ensure: and ifCurtailed: as unwind-protect frames. This was one of Andreas' neatest hacks (am I right in thinking this was Andreas Raab's scheme?), in that he added unwind-protect without needing e.g. another status bit in the CompiledMethod header. He could just use the primitive number that was already there. As far as ifCurtailed: not evaluating its argument, that is its semantics. ensure: always evaluates its argument, after evaluating its body. ifCurtailed: only evaluates its argument if a non-local return or exception return is taken and the normal return path is not taken. See Context>>#resume:through: which runs the ensure: & ifCurtailed: blocks. None of the above are critical, but I am curious about them. > Thank you in advance for any clarifications, > > Florin > HTH _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From florin.mateoc at gmail.com Mon Aug 31 20:34:54 2020 From: florin.mateoc at gmail.com (Florin Mateoc) Date: Mon, 31 Aug 2020 16:34:54 -0400 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: Hi Eliot, Thank you for your reply and for the extra details about #instVarAt:. To answer your question, I would have expected the primitive to fail for non-pointers objects, as I associate in my mind instvars with named instvars, but I am not invested in this (mis)association, so thank you for correcting it. But regarding #ifCurtailed, I know that primitives198 1nd 199 are not "real", I was referring to something else. The primitive failure code in the method #ifCurtailed never touches the argument, regardless of the path taken. I think that is incorrect, even if only for documentation purposes. All the best, Florin On Mon, Aug 31, 2020 at 3:42 PM Eliot Miranda wrote: > > Hi Florin, > > On Mon, Aug 31, 2020 at 7:30 AM Florin Mateoc > wrote: > >> >> Hi, >> >> I had some unexpected results while looking at some primitives in the >> system, and I wanted to ask if they are expected/intentional: >> >> 1. 'ab' instVarAt: 1 => 97 (and 'ab' instVarAt: 2 => 98) >> I would have thought that #instVarAt: has pointer granularity, so I >> am curious if the observed behavior is an accident or intentional (and >> maybe even used somewhere) >> > > Since a ByteString's indexed inst vars are bytes this is as expected. > What would you have expected? Smalltalk-80 has always behaved this way. > > There is a little more to this story. In Spur, instVarAt:[put:] is > actually implemented by a new primitive slotAt:[put:]. Why? > > Spur has a lazy become scheme which means that become is implemented by > morphing objects into forwarders to copies of objects. So if a become: b, > then the system allocated copies of a and b, say a' and b', and morphs a > into a forwarder to b', and b into a forwarder to a'. Forwarders are > followed lazily, either when a message is sent to a forwarder or when a > primitive encounters a forwarder somewhere within the objects it consumes. > When a primitive fails the VM scans the input arguments to a depth specific > to the primitive and if it finds references to forwarders, fixes them up to > point to the targets of the forwarders, and retries the primitive. The old > implementation of instVarAt:[put:] had primities that failed for indexes > beyond the named instance variables, and handled indexed inst vars in > primitive failure code: > > Object>>instVarAt: index > "Primitive. Answer a fixed variable in an object. The numbering of the > variables corresponds to the named instance variables. Fail if the index > is not an Integer or is not the index of a fixed variable. Essential. See > Object documentation whatIsAPrimitive." > > > "Access beyond fixed variables." > ^self basicAt: index - self class instSize > > Chris Muller uses instVarAt:[put:] on large arrays in his Magma database. > He was noticing a severe slow down in Magma on Spur because > instVarAt:[put:] was failing, the entire Array was being scanned for > forwarders, and then the primitive actually failed and the basicAt:put: ran. > > The solution to this was to replace primitives 73 & 74 with the new > slotAt:[put:] primitives 173 & 174. Now the primitive does not fail, and > performance is restored (and much improved because Spur is faster). > > >> 2. | o | o := Object new. (WeakArray with: o) pointsTo: o => true >> I thought the main use case for #pointsTo: was to find hard >> references (e.g. for chasing memory leaks). The current behavior actually >> makes that use case a little more difficult to implement, since you have to >> special case weak references. When would one be interested in finding weak >> references? >> > > I can't answer this. The design decision was made a whole ago. It would > be easy to add pointsStronglyTo: and implement that correctly. Remember > that references from named inst vars of weak objects are strong references. > Only references from indexed inst vars of weak objects are weak. > > >> 3. The comment and the primitive used in #ensure: and #ifCurtailed: are >> the same, but the primitive failure code is different - the one for >> #ifCurtailed seems buggy, it never evaluates the argument >> > > Ah, this is a neat hack. The primitive numbers are not actually > primitives, These primitives always fail, and the blocks are evaluated > with the valueNoContextSwitch send in the method body. Instead the > primitive numbers are used by the VM to mark the activations of ensure: and > ifCurtailed: as unwind-protect frames. This was one of Andreas' neatest > hacks (am I right in thinking this was Andreas Raab's scheme?), in that he > added unwind-protect without needing e.g. another status bit in the > CompiledMethod header. He could just use the primitive number that was > already there. > > As far as ifCurtailed: not evaluating its argument, that is its semantics. > ensure: always evaluates its argument, after evaluating its body. > ifCurtailed: only evaluates its argument if a non-local return or > exception return is taken and the normal return path is not taken. See > Context>>#resume:through: which runs the ensure: & ifCurtailed: blocks. > > None of the above are critical, but I am curious about them. >> Thank you in advance for any clarifications, >> >> Florin >> > > HTH > _,,,^..^,,,_ > best, Eliot > -------------- next part -------------- An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Mon Aug 31 20:40:09 2020 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Mon, 31 Aug 2020 13:40:09 -0700 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: Hi Florin, On Mon, Aug 31, 2020 at 1:35 PM Florin Mateoc wrote: > > Hi Eliot, > > Thank you for your reply and for the extra details about #instVarAt:. > To answer your question, I would have expected the primitive to fail for > non-pointers objects, as I associate in my mind instvars with named > instvars, but I am not invested in this (mis)association, so thank you for > correcting it. > > But regarding #ifCurtailed, I know that primitives198 1nd 199 are not > "real", I was referring to something else. The primitive failure code in > the method #ifCurtailed never touches the argument, regardless of the path > taken. I think that is incorrect, even if only for documentation purposes. > I don't understand. I see no error code. We're talking about this method right? BlockClosure>>ifCurtailed: aBlock "Evaluate the receiver with an abnormal termination action. Evaluate aBlock only if execution is unwound during execution of the receiver. If execution of the receiver finishes normally do not evaluate aBlock. N.B. This method is *not* implemented as a primitive. Primitive 198 always fails. The VM uses prim 198 in a context's method as the mark for an ensure:/ifCurtailed: activation." | complete result | result := self valueNoContextSwitch. complete := true. ^result > All the best, > Florin > Cheers! > > On Mon, Aug 31, 2020 at 3:42 PM Eliot Miranda > wrote: > >> >> Hi Florin, >> >> On Mon, Aug 31, 2020 at 7:30 AM Florin Mateoc >> wrote: >> >>> >>> Hi, >>> >>> I had some unexpected results while looking at some primitives in the >>> system, and I wanted to ask if they are expected/intentional: >>> >>> 1. 'ab' instVarAt: 1 => 97 (and 'ab' instVarAt: 2 => 98) >>> I would have thought that #instVarAt: has pointer granularity, so I >>> am curious if the observed behavior is an accident or intentional (and >>> maybe even used somewhere) >>> >> >> Since a ByteString's indexed inst vars are bytes this is as expected. >> What would you have expected? Smalltalk-80 has always behaved this way. >> >> There is a little more to this story. In Spur, instVarAt:[put:] is >> actually implemented by a new primitive slotAt:[put:]. Why? >> >> Spur has a lazy become scheme which means that become is implemented by >> morphing objects into forwarders to copies of objects. So if a become: b, >> then the system allocated copies of a and b, say a' and b', and morphs a >> into a forwarder to b', and b into a forwarder to a'. Forwarders are >> followed lazily, either when a message is sent to a forwarder or when a >> primitive encounters a forwarder somewhere within the objects it consumes. >> When a primitive fails the VM scans the input arguments to a depth specific >> to the primitive and if it finds references to forwarders, fixes them up to >> point to the targets of the forwarders, and retries the primitive. The old >> implementation of instVarAt:[put:] had primities that failed for indexes >> beyond the named instance variables, and handled indexed inst vars in >> primitive failure code: >> >> Object>>instVarAt: index >> "Primitive. Answer a fixed variable in an object. The numbering of the >> variables corresponds to the named instance variables. Fail if the index >> is not an Integer or is not the index of a fixed variable. Essential. See >> Object documentation whatIsAPrimitive." >> >> >> "Access beyond fixed variables." >> ^self basicAt: index - self class instSize >> >> Chris Muller uses instVarAt:[put:] on large arrays in his Magma database. >> He was noticing a severe slow down in Magma on Spur because >> instVarAt:[put:] was failing, the entire Array was being scanned for >> forwarders, and then the primitive actually failed and the basicAt:put: ran. >> >> The solution to this was to replace primitives 73 & 74 with the new >> slotAt:[put:] primitives 173 & 174. Now the primitive does not fail, and >> performance is restored (and much improved because Spur is faster). >> >> >>> 2. | o | o := Object new. (WeakArray with: o) pointsTo: o => true >>> I thought the main use case for #pointsTo: was to find hard >>> references (e.g. for chasing memory leaks). The current behavior actually >>> makes that use case a little more difficult to implement, since you have to >>> special case weak references. When would one be interested in finding weak >>> references? >>> >> >> I can't answer this. The design decision was made a whole ago. It would >> be easy to add pointsStronglyTo: and implement that correctly. Remember >> that references from named inst vars of weak objects are strong references. >> Only references from indexed inst vars of weak objects are weak. >> >> >>> 3. The comment and the primitive used in #ensure: and #ifCurtailed: are >>> the same, but the primitive failure code is different - the one for >>> #ifCurtailed seems buggy, it never evaluates the argument >>> >> >> Ah, this is a neat hack. The primitive numbers are not actually >> primitives, These primitives always fail, and the blocks are evaluated >> with the valueNoContextSwitch send in the method body. Instead the >> primitive numbers are used by the VM to mark the activations of ensure: and >> ifCurtailed: as unwind-protect frames. This was one of Andreas' neatest >> hacks (am I right in thinking this was Andreas Raab's scheme?), in that he >> added unwind-protect without needing e.g. another status bit in the >> CompiledMethod header. He could just use the primitive number that was >> already there. >> >> As far as ifCurtailed: not evaluating its argument, that is its >> semantics. ensure: always evaluates its argument, after evaluating its >> body. ifCurtailed: only evaluates its argument if a non-local return or >> exception return is taken and the normal return path is not taken. See >> Context>>#resume:through: which runs the ensure: & ifCurtailed: blocks. >> >> None of the above are critical, but I am curious about them. >>> Thank you in advance for any clarifications, >>> >>> Florin >>> >> >> HTH >> _,,,^..^,,,_ >> best, Eliot >> > -- _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From florin.mateoc at gmail.com Mon Aug 31 20:51:30 2020 From: florin.mateoc at gmail.com (Florin Mateoc) Date: Mon, 31 Aug 2020 16:51:30 -0400 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: Hi Eliot, Sorry about top-posting previously. Stupid Gmail! Eliot Miranda via squeak.org 4:40 PM (4 minutes ago) to Open On Mon, Aug 31, 2020 at 4:40 PM Eliot Miranda wrote: > > Hi Florin, > > On Mon, Aug 31, 2020 at 1:35 PM Florin Mateoc > wrote: > >> >> Hi Eliot, >> >> Thank you for your reply and for the extra details about #instVarAt:. >> To answer your question, I would have expected the primitive to fail for >> non-pointers objects, as I associate in my mind instvars with named >> instvars, but I am not invested in this (mis)association, so thank you for >> correcting it. >> >> But regarding #ifCurtailed, I know that primitives198 1nd 199 are not >> "real", I was referring to something else. The primitive failure code in >> the method #ifCurtailed never touches the argument, regardless of the path >> taken. I think that is incorrect, even if only for documentation purposes. >> > > I don't understand. I see no error code. We're talking about this method > right? > > BlockClosure>>ifCurtailed: aBlock > "Evaluate the receiver with an abnormal termination action. > Evaluate aBlock only if execution is unwound during execution > of the receiver. If execution of the receiver finishes normally do > not evaluate aBlock. N.B. This method is *not* implemented as a > primitive. Primitive 198 always fails. The VM uses prim 198 in a > context's method as the mark for an ensure:/ifCurtailed: activation." > | complete result | > > result := self valueNoContextSwitch. > complete := true. > ^result > > I did not mention an error code, I was talking about the "primitive failure code", referring to the Smalltalk code that gets invoked when the primitive fails (the three rows after the pragma). This Smalltalk code does not touch the method's argument (aBlock), so it looks as if aBlock is never evaluated Florin -------------- next part -------------- An HTML attachment was scrubbed... URL: From tim at rowledge.org Mon Aug 31 20:52:10 2020 From: tim at rowledge.org (tim Rowledge) Date: Mon, 31 Aug 2020 13:52:10 -0700 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: > On 2020-08-31, at 12:42 PM, Eliot Miranda wrote: > > Ah, this is a neat hack. The primitive numbers are not actually primitives, These primitives always fail, and the blocks are evaluated with the valueNoContextSwitch send in the method body. Instead the primitive numbers are used by the VM to mark the activations of ensure: and ifCurtailed: as unwind-protect frames. This was one of Andreas' neatest hacks (am I right in thinking this was Andreas Raab's scheme?), in that he added unwind-protect without needing e.g. another status bit in the CompiledMethod header. He could just use the primitive number that was already there. The exception handling was added between 2.3 & 2.6 back in 1999. The TFEI guys did a large chunk of it, I'm just about certain Craig came up with the #valueUninterruptably cleverness to make it work on VMs without direct support, I did the original VM support and using the 'fake' prim was probably the result of some discussions on how to tag contexts easily between a bunch of us. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: XER: Exclusive ERror From florin.mateoc at gmail.com Mon Aug 31 21:00:03 2020 From: florin.mateoc at gmail.com (Florin Mateoc) Date: Mon, 31 Aug 2020 17:00:03 -0400 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: I think this is especially confusing since the comment says that the primitive always fails, and then the expectation is that the Smalltalk code that follows is executed instead. But that code does not do what the method actually does On Mon, Aug 31, 2020 at 4:51 PM Florin Mateoc wrote: > Hi Eliot, > > Sorry about top-posting previously. Stupid Gmail! > > Eliot Miranda via > squeak.org > 4:40 PM (4 minutes ago) > > > to Open > > On Mon, Aug 31, 2020 at 4:40 PM Eliot Miranda > wrote: > >> >> Hi Florin, >> >> On Mon, Aug 31, 2020 at 1:35 PM Florin Mateoc >> wrote: >> >>> >>> Hi Eliot, >>> >>> Thank you for your reply and for the extra details about #instVarAt:. >>> To answer your question, I would have expected the primitive to fail for >>> non-pointers objects, as I associate in my mind instvars with named >>> instvars, but I am not invested in this (mis)association, so thank you for >>> correcting it. >>> >>> But regarding #ifCurtailed, I know that primitives198 1nd 199 are not >>> "real", I was referring to something else. The primitive failure code in >>> the method #ifCurtailed never touches the argument, regardless of the path >>> taken. I think that is incorrect, even if only for documentation purposes. >>> >> >> I don't understand. I see no error code. We're talking about this >> method right? >> >> BlockClosure>>ifCurtailed: aBlock >> "Evaluate the receiver with an abnormal termination action. >> Evaluate aBlock only if execution is unwound during execution >> of the receiver. If execution of the receiver finishes normally do >> not evaluate aBlock. N.B. This method is *not* implemented as a >> primitive. Primitive 198 always fails. The VM uses prim 198 in a >> context's method as the mark for an ensure:/ifCurtailed: activation." >> | complete result | >> >> result := self valueNoContextSwitch. >> complete := true. >> ^result >> >> > > > > I did not mention an error code, I was talking about the "primitive > failure code", referring to the Smalltalk code that gets invoked when the > primitive fails (the three rows after the pragma). > This Smalltalk code does not touch the method's argument (aBlock), so it > looks as if aBlock is never evaluated > > Florin > -------------- next part -------------- An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Mon Aug 31 22:00:34 2020 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Mon, 31 Aug 2020 15:00:34 -0700 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: On Mon, Aug 31, 2020 at 2:00 PM Florin Mateoc wrote: > > I think this is especially confusing since the comment says that the > primitive always fails, and then the expectation is that the Smalltalk code > that follows is executed instead. But that code does not do what the method > actually does > I disagree. It does exactly what the method does (it *is* the implementation of the method) unless the stack is unwound. Yes, the comment could point the reader to Context>>#resume:through: which runs the ensure: & ifCurtailed: blocks on unwind. Bit otherwise ifCurtailed: is not somehow magically not executed. It is what it is ;-) As I said earlier, ifCurtailed: only evaluates its argument if a non-local return or exception return is taken and the normal return path is not taken. See Context>>#resume:through: which runs the ensure: & ifCurtailed: blocks. Can I confirm that your dissatisfaction is with the comment? Or do you really think the ifCurtailed: method does not execute verbatim in the absence of unwinds? If the former, you're welcome to submit an improved comment. If the latter, you're mistaken. On Mon, Aug 31, 2020 at 4:51 PM Florin Mateoc > wrote: > >> Hi Eliot, >> >> Sorry about top-posting previously. Stupid Gmail! >> >> Eliot Miranda via >> squeak.org >> 4:40 PM (4 minutes ago) >> >> >> to Open >> >> On Mon, Aug 31, 2020 at 4:40 PM Eliot Miranda >> wrote: >> >>> >>> Hi Florin, >>> >>> On Mon, Aug 31, 2020 at 1:35 PM Florin Mateoc >>> wrote: >>> >>>> >>>> Hi Eliot, >>>> >>>> Thank you for your reply and for the extra details about #instVarAt:. >>>> To answer your question, I would have expected the primitive to fail >>>> for non-pointers objects, as I associate in my mind instvars with named >>>> instvars, but I am not invested in this (mis)association, so thank you for >>>> correcting it. >>>> >>>> But regarding #ifCurtailed, I know that primitives198 1nd 199 are not >>>> "real", I was referring to something else. The primitive failure code in >>>> the method #ifCurtailed never touches the argument, regardless of the path >>>> taken. I think that is incorrect, even if only for documentation purposes. >>>> >>> >>> I don't understand. I see no error code. We're talking about this >>> method right? >>> >>> BlockClosure>>ifCurtailed: aBlock >>> "Evaluate the receiver with an abnormal termination action. >>> Evaluate aBlock only if execution is unwound during execution >>> of the receiver. If execution of the receiver finishes normally do >>> not evaluate aBlock. N.B. This method is *not* implemented as a >>> primitive. Primitive 198 always fails. The VM uses prim 198 in a >>> context's method as the mark for an ensure:/ifCurtailed: activation." >>> | complete result | >>> >>> result := self valueNoContextSwitch. >>> complete := true. >>> ^result >>> >>> >> >> >> >> I did not mention an error code, I was talking about the "primitive >> failure code", referring to the Smalltalk code that gets invoked when the >> primitive fails (the three rows after the pragma). >> This Smalltalk code does not touch the method's argument (aBlock), so it >> looks as if aBlock is never evaluated >> >> Florin >> > -- _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From florin.mateoc at gmail.com Mon Aug 31 22:29:58 2020 From: florin.mateoc at gmail.com (Florin Mateoc) Date: Mon, 31 Aug 2020 18:29:58 -0400 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: On Mon, Aug 31, 2020 at 6:00 PM Eliot Miranda wrote: > > > > On Mon, Aug 31, 2020 at 2:00 PM Florin Mateoc > wrote: > >> >> I think this is especially confusing since the comment says that the >> primitive always fails, and then the expectation is that the Smalltalk code >> that follows is executed instead. But that code does not do what the method >> actually does >> > > I disagree. It does exactly what the method does (it *is* the > implementation of the method) unless the stack is unwound. Yes, the > comment could point the reader to Context>>#resume:through: which runs > the ensure: & ifCurtailed: blocks on unwind. Bit otherwise ifCurtailed: is > not somehow magically not executed. It is what it is ;-) > > As I said earlier, ifCurtailed: only evaluates its argument if a > non-local return or exception return is taken and the normal return path is > not taken. See Context>>#resume:through: which runs the ensure: & > ifCurtailed: blocks. > > Can I confirm that your dissatisfaction is with the comment? Or do you > really think the ifCurtailed: method does not execute verbatim in the > absence of unwinds? If the former, you're welcome to submit an improved > comment. If the latter, you're mistaken. > > Of course I agree that the ifCurtailed: method does execute verbatim in the absence of unwind. But the method does not only execute in the absence of unwinds. So my "dissatisfaction" is not just with the comment. While it could be somewhat be addressed by a comment, I think this is an instance where the vm is caught cheating. The shown Smalltalk code is not what gets executed in the presence of unwinds (as opposed to the code shown in #ensure: ). The execution of the argument block is hidden inside the vm -------------- next part -------------- An HTML attachment was scrubbed... URL: From asqueaker at gmail.com Mon Aug 31 23:03:17 2020 From: asqueaker at gmail.com (Chris Muller) Date: Mon, 31 Aug 2020 18:03:17 -0500 Subject: [Vm-dev] questions about a couple of primitives In-Reply-To: References: Message-ID: Eliot, > Spur has a lazy become scheme which means that become is implemented by morphing objects into forwarders to copies of objects. So if a become: b, then the system allocated copies of a and b, say a' and b', and morphs a into a forwarder to b', and b into a forwarder to a'. Forwarders are followed lazily, either when a message is sent to a forwarder or when a primitive encounters a forwarder somewhere within the objects it consumes. When a primitive fails the VM scans the input arguments to a depth specific to the primitive and if it finds references to forwarders, fixes them up to point to the targets of the forwarders, and retries the primitive. The old implementation of instVarAt:[put:] had primities that failed for indexes beyond the named instance variables, and handled indexed inst vars in primitive failure code: > > Object>>instVarAt: index > "Primitive. Answer a fixed variable in an object. The numbering of the > variables corresponds to the named instance variables. Fail if the index > is not an Integer or is not the index of a fixed variable. Essential. See > Object documentation whatIsAPrimitive." > > > "Access beyond fixed variables." > ^self basicAt: index - self class instSize > > Chris Muller uses instVarAt:[put:] on large arrays in his Magma database. He was noticing a severe slow down in Magma on Spur because instVarAt:[put:] was failing, the entire Array was being scanned for forwarders, and then the primitive actually failed and the basicAt:put: ran. > > The solution to this was to replace primitives 73 & 74 with the new slotAt:[put:] primitives 173 & 174. Now the primitive does not fail, and performance is restored (and much improved because Spur is faster). I just checked, apparently I'm still using my own #slotAt:[put:] from 2014, which reads: slotAt: anInteger "Flat slot access. Answer the object referenced by the receiver at its anInteger'th slot." | namedSize | ^ anInteger > (namedSize:=self class instSize) ifTrue: [ self basicAt: (anInteger-namedSize) ] ifFalse: [ self instVarAt: anInteger ] The timestamp on #instVarAt: using primitve 173 is 2017, so it sounds like I can go back to simply using #instVarAt: instead of my own #slotAt:, do you agree? Thanks. - Chris