[Vm-dev] VM Maker: VMMaker.oscog-eem.2060.mcz
Levente Uzonyi
leves at caesar.elte.hu
Sat Dec 31 16:48:33 UTC 2016
On Sat, 31 Dec 2016, commits at source.squeak.org wrote:
>
> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2060.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-eem.2060
> Author: eem
> Time: 30 December 2016, 5:35:05.715938 pm
> UUID: f9dcc3c5-4596-4d3b-a6f1-40a2dde5c7f5
> Ancestors: VMMaker.oscog-eem.2059
>
> SocketPluginSimulator:
> SocketPlugin simulation sufficient to do a diff of a changed package against source.squeak.org/trunk, and indeed sufficient to get far enough to provke an assert-fail in compaction.
Great progress.
>
> Simulate only ipv4.
>
> Clean up primitiveHasSocketAccess to be smart syntax and eliminate the cCode: from initialiseModule.
>
> =============== Diff against VMMaker.oscog-eem.2059 ===============
>
> Item was added:
> + ----- Method: NewCoObjectMemorySimulator>>signalSemaphoreWithIndex: (in category 'simulation only') -----
> + signalSemaphoreWithIndex: index
> + "hack around the CoInterpreter/ObjectMemory split refactoring"
> + ^coInterpreter signalSemaphoreWithIndex: index!
>
> Item was added:
> + ----- Method: NewObjectMemorySimulator>>signalSemaphoreWithIndex: (in category 'simulation only') -----
> + signalSemaphoreWithIndex: index
> + "hack around the CoInterpreter/ObjectMemory split refactoring"
> + ^coInterpreter signalSemaphoreWithIndex: index!
>
> Item was added:
> + ----- Method: SocketPlugin class>>simulatorClass (in category 'simulation') -----
> + simulatorClass
> + ^SmartSyntaxPluginSimulator!
>
> Item was changed:
> ----- Method: SocketPlugin>>initialiseModule (in category 'initialize-release') -----
> initialiseModule
> <export: true>
> sDSAfn := interpreterProxy ioLoadFunction: 'secDisableSocketAccess' From: 'SecurityPlugin'.
> sHSAfn := interpreterProxy ioLoadFunction: 'secHasSocketAccess' From: 'SecurityPlugin'.
> sCCTPfn := interpreterProxy ioLoadFunction: 'secCanConnectToPort' From: 'SecurityPlugin'.
> sCCLOPfn := interpreterProxy ioLoadFunction: 'secCanListenOnPort' From: 'SecurityPlugin'.
> sCCSOTfn := interpreterProxy ioLoadFunction: 'secCanCreateSocketOfType' From: 'SecurityPlugin'.
> + ^self socketInit!
> - ^self cCode: 'socketInit()' inSmalltalk:[true]!
>
> Item was changed:
> ----- Method: SocketPlugin>>primitiveHasSocketAccess (in category 'security primitives') -----
> primitiveHasSocketAccess
> + self primitive: 'primitiveHasSocketAccess'.
> - | hasAccess |
> - <export: true>
> "If the security plugin can be loaded, use it to check .
> If not, assume it's ok"
> + ^(sHSAfn = 0
> + or: [self cCode: ' ((sqInt (*) (void)) sHSAfn)()' inSmalltalk: [true]]) asBooleanObj!
> - hasAccess := sHSAfn = 0
> - or: [self cCode: ' ((sqInt (*) (void)) sHSAfn)()' inSmalltalk:[true]].
> - interpreterProxy pop: 1.
> - interpreterProxy pushBool: hasAccess!
>
> Item was added:
> + SocketPlugin subclass: #SocketPluginSimulator
> + instanceVariableNames: 'openSocketHandles externalSemaphores hostSocketToSimSocketMap simSocketToHostSocketMap fakeAddressCounter resolverSemaphoreIndex ipv6support'
> + classVariableNames: ''
> + poolDictionaries: ''
> + category: 'VMMaker-InterpreterSimulation'!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>close (in category 'initialize-release') -----
> + close "close any sockets that ST may have opened"
> + openSocketHandles do: [:h | self closeAndDestroy: h].
> + Smalltalk unregisterExternalObjects: externalSemaphores!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>closeAndDestroy: (in category 'initialize-release') -----
> + closeAndDestroy: socketHandle
> + "c.f. Socket closeAndDestroy: timeoutSeconds"
> + | fakeSocket |
> + fakeSocket := Socket basicNew.
> + [(fakeSocket primSocketConnectionStatus: socketHandle) = (Socket classPool at: #Connected) ifTrue:
> + [fakeSocket primSocketCloseConnection: socketHandle].
> + fakeSocket
> + primSocketAbortConnection: socketHandle;
> + primSocketDestroy: socketHandle]
> + on: SocketPrimitiveFailed
> + do: [:ex| Transcript cr; show: ex message]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>hostSocketHandleFromSimSocketHandle: (in category 'simulation support') -----
> + hostSocketHandleFromSimSocketHandle: socketHandleCArray
> + "Answer the corresponding host socketHandle for the simulation socketHandle, or nil if none, failing the primitive."
> + ^simSocketToHostSocketMap
> + at: (self simSocketHandleFrom: socketHandleCArray)
> + ifAbsent: [interpreterProxy primitiveFail. nil]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>ipv6support (in category 'accessing') -----
> + ipv6support
> +
> + ^ ipv6support
> + !
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>ipv6support: (in category 'accessing') -----
> + ipv6support: anObject
> +
> + ipv6support := anObject.
> + !
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>map:to:type:register:spawning:and:and: (in category 'simulation support') -----
> + map: hostSocketHandle to: simSockPtr type: socketType register: semaphores spawning: blockOne and: blockTwo and: blockThree
> + | simSocket |
> + "SQSocket is typedef struct { int sessionID; int socketType; void *privateSocketPtr; } SQSocket"
> + simSocket := ByteArray new: (self sizeof: #SQSocket).
> + simSocket
> + unsignedLongAt: 1 put: interpreterProxy getThisSessionID;
> + unsignedLongAt: 5 put: socketType.
> + simSocket size = 12
> + ifTrue: [simSocket unsignedLongAt: 9 put: (fakeAddressCounter := fakeAddressCounter + 64)]
> + ifFalse: [simSocket unsignedLongLongAt: 9 put: (fakeAddressCounter := fakeAddressCounter + 80)].
> + self assert: ((interpreterProxy isBytes: simSockPtr cPtrAsOop)
> + and: [(interpreterProxy numBytesOf: simSockPtr cPtrAsOop) = simSocket size]).
> + 1 to: simSocket size do:
> + [:i| simSockPtr at: i - 1 put: (simSocket at: i)].
> + self assert: (self simSocketHandleFrom: simSockPtr) = simSocket.
> + openSocketHandles add: hostSocketHandle.
> + hostSocketToSimSocketMap at: hostSocketHandle put: simSocket.
> + simSocketToHostSocketMap at: simSocket put: hostSocketHandle.
> + externalSemaphores addAll: semaphores.
> + "N.B. These don't need registering. Eventually they will end up
> + waiting on semaphores that have been unregistered, and hence
> + will get garbage collected, along with these processes."
> + blockOne fork.
> + blockTwo fork.
> + blockThree fork!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>netAddressAsByteArrayFromInt: (in category 'simulation support') -----
> + netAddressAsByteArrayFromInt: netAddress
> + ^ByteArray
> + with: ((netAddress bitShift: -24) bitAnd: 16rFF)
> + with: ((netAddress bitShift: -16) bitAnd: 16rFF)
> + with: ((netAddress bitShift: -8) bitAnd: 16rFF)
> + with: (netAddress bitAnd: 16rFF)!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>simSocketHandleFrom: (in category 'simulation support') -----
> + simSocketHandleFrom: socketHandleCArray
> + | simSocket |
> + "SQSocket is typedef struct { int sessionID; int socketType; void *privateSocketPtr; } SQSocket"
> + simSocket := ByteArray new: (self sizeof: #SQSocket).
> + 1 to: simSocket size do:
> + [:i|
> + simSocket at: i put: (socketHandleCArray at: i - 1)].
> + ^simSocket!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>simulator: (in category 'accessing') -----
> + simulator: aSmartSyntaxPluginSimulator
> + super simulator: aSmartSyntaxPluginSimulator.
> + aSmartSyntaxPluginSimulator logging: true!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>socketInit (in category 'initialize-release') -----
> + socketInit
> + openSocketHandles := Set new.
> + externalSemaphores := Set new.
> + hostSocketToSimSocketMap := Dictionary new.
> + simSocketToHostSocketMap := Dictionary new.
> + fakeAddressCounter := 16r50C4E70. "Socket, if you squint at it right..."
> + "Set all the security functions to zero so simulation does't need to work fully."
> + sDSAfn := sHSAfn := sCCTPfn := sCCLOPfn := sCCSOTfn := 0.
> + "for now..."
> + ipv6support := false.
> + ^true!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqNetworkInit: (in category 'simulation') -----
> + sqNetworkInit: resolverSemaIndex
> + "Simply assume the network is initialized."
> + (NetNameResolver classPool at: #HaveNetwork) ifFalse:
> + [NetNameResolver initializeNetwork].
> + resolverSemaphoreIndex
> + ifNil: [resolverSemaphoreIndex := resolverSemaIndex]
> + ifNotNil: [self assert: resolverSemaphoreIndex = resolverSemaIndex].
> + ^0!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqResolverHostNameSize (in category 'simulation') -----
> + sqResolverHostNameSize
> + ipv6support ifTrue: [^NetNameResolver primHostNameSize].
> + interpreterProxy primitiveFail!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqResolverNameLookupResult (in category 'simulation') -----
> + sqResolverNameLookupResult
> + "For now don't simulate the implicit semaphore."
> + | bytes |
> + bytes := NetNameResolver primNameLookupResult.
> + self assert: bytes size = 4.
> + "Effectively netAddressToInt: bytes"
> + ^ ((bytes at: 4)) +
> + ((bytes at: 3) <<8) +
> + ((bytes at: 2) <<16) +
> + ((bytes at: 1) <<24)!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqResolverStartName:Lookup: (in category 'simulation') -----
> + sqResolverStartName: aCArray Lookup: size
> + "For now don't simulate the implicit semaphore."
> + | hostName busy |
> + busy := NetNameResolver classPool at: #ResolverBusy.
> + hostName := self st: (String new: size) rn: aCArray cpy: size.
> + NetNameResolver primStartLookupOfName: hostName.
> + resolverSemaphoreIndex ifNotNil:
> + [[[NetNameResolver primNameResolverStatus = busy] whileTrue:
> + [(Delay forSeconds: 1) wait].
> + interpreterProxy signalSemaphoreWithIndex: resolverSemaphoreIndex] fork]
> + !
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqResolverStatus (in category 'simulation') -----
> + sqResolverStatus
> + ^NetNameResolver primNameResolverStatus!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqSocket:ConnectTo:Port: (in category 'simulation') -----
> + sqSocket: socketHandle ConnectTo: addr Port: port
> + ^[Socket basicNew
> + primSocket: ((self hostSocketHandleFromSimSocketHandle: socketHandle) ifNil: [^self])
> + connectTo: (self netAddressAsByteArrayFromInt: addr)
> + port: port]
> + on: SocketPrimitiveFailed
> + do: [:ex|
> + interpreterProxy primitiveFail.
> + 0]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqSocket:CreateNetType:SocketType:RecvBytes:SendBytes:SemaID:ReadSemaID:WriteSemaID: (in category 'simulation') -----
> + sqSocket: sockPtr CreateNetType: netType SocketType: socketType RecvBytes: recvBufSize SendBytes: sendBufSize SemaID: semaIndex ReadSemaID: readSemaIndex WriteSemaID: writeSemaIndex
> + "Simulate the sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID function.
> + We descend beneath the Socket abstraftion to simulate as accurately as possible."
> + | semaphoresAndIndexes semaphores indexes socketHandle |
> + semaphoresAndIndexes := Smalltalk newExternalSemaphores: 3.
> + semaphores := semaphoresAndIndexes first.
> + indexes := semaphoresAndIndexes second.
> + socketHandle := [Socket basicNew
> + primSocketCreateNetwork: netType
> + type: socketType
> + receiveBufferSize: recvBufSize
> + sendBufSize: sendBufSize
> + semaIndex: indexes first
> + readSemaIndex: indexes second
> + writeSemaIndex: indexes third]
> + on: SocketPrimitiveFailed
> + do: [:ex|
> + #failed].
> + socketHandle == #failed ifTrue:
> + [interpreterProxy primitiveFail.
> + Smalltalk unregisterExternalObjects: semaphores.
> + ^self].
> + "N.B. There is now a Processor yield in doSignalExternalSemaphores: every 100 virtual microseconds.
> + This allows these to make progress. Their job is to map a host signal into a signal of the relevant index."
> + self map: socketHandle
> + to: sockPtr
> + type: socketType
> + register: semaphores
> + spawning: [[semaphores first wait. interpreterProxy signalSemaphoreWithIndex: semaIndex] repeat]
> + and: [[semaphores second wait. interpreterProxy signalSemaphoreWithIndex: readSemaIndex] repeat]
> + and: [[semaphores third wait. interpreterProxy signalSemaphoreWithIndex: writeSemaIndex] repeat]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqSocket:ReceiveDataBuf:Count: (in category 'simulation') -----
> + sqSocket: socketHandleCArray ReceiveDataBuf: bufferStartCArray Count: numBytes
> + ^[| buffer n |
> + buffer := ByteArray new: numBytes.
> + n := Socket basicNew
> + primSocket: ((self hostSocketHandleFromSimSocketHandle: socketHandleCArray) ifNil: [^0])
> + receiveDataInto: buffer
> + startingAt: 1
> + count: numBytes.
> + 1 to: n do:
> + [:i|
> + bufferStartCArray at: i - 1 put: (buffer at: i)].
> + n]
> + on: SocketPrimitiveFailed
> + do: [:ex|
> + interpreterProxy primitiveFail.
> + 0]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqSocket:SendDataBuf:Count: (in category 'simulation') -----
> + sqSocket: socketHandleCArray SendDataBuf: bufferStartCArray Count: numBytes
> + | data |
> + data := ByteArray new: numBytes.
> + 1 to: numBytes do:
> + [:i| data at: i put: (bufferStartCArray at: i - 1)].
> + ^[Socket basicNew
> + primSocket: ((self hostSocketHandleFromSimSocketHandle: socketHandleCArray) ifNil: [^0])
> + sendData: data
> + startIndex: 1
> + count: numBytes]
> + on: SocketPrimitiveFailed
> + do: [:ex|
> + interpreterProxy primitiveFail.
> + 0]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqSocketConnectionStatus: (in category 'simulation') -----
> + sqSocketConnectionStatus: socketHandleCArray
> + ^[Socket basicNew
> + primSocketConnectionStatus: ((self hostSocketHandleFromSimSocketHandle: socketHandleCArray) ifNil: [^-1])]
> + on: SocketPrimitiveFailed
> + do: [:ex|
> + interpreterProxy primitiveFail.
> + -1]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqSocketDestroy: (in category 'simulation') -----
> + sqSocketDestroy: socketHandleCArray
> + | simHandle hostHandle |
> + simHandle := self simSocketHandleFrom: socketHandleCArray.
> + hostHandle := simSocketToHostSocketMap removeKey: simHandle ifAbsent: [].
> + hostHandle ifNil:
> + [interpreterProxy primitiveFail.
> + ^self].
> + hostSocketToSimSocketMap removeKey: hostHandle ifAbsent: [].
> + [Socket basicNew primSocketDestroy: hostHandle]
> + on: SocketPrimitiveFailed
> + do: [:ex|
> + interpreterProxy primitiveFail]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqSocketReceiveDataAvailable: (in category 'simulation') -----
> + sqSocketReceiveDataAvailable: socketHandleCArray
> + ^[Socket basicNew
> + primSocketReceiveDataAvailable: ((self hostSocketHandleFromSimSocketHandle: socketHandleCArray) ifNil: [^false])]
> + on: SocketPrimitiveFailed
> + do: [:ex|
> + interpreterProxy primitiveFail.
> + false]!
>
> Item was added:
> + ----- Method: SocketPluginSimulator>>sqSocketSendDone: (in category 'simulation') -----
> + sqSocketSendDone: socketHandleCArray
> + ^[Socket basicNew
> + primSocketSendDone: ((self hostSocketHandleFromSimSocketHandle: socketHandleCArray) ifNil: [^false])]
> + on: SocketPrimitiveFailed
> + do: [:ex|
> + interpreterProxy primitiveFail.
> + false]!
>
> Item was added:
> + ----- Method: SpurMemoryManager>>signalSemaphoreWithIndex: (in category 'simulation only') -----
> + signalSemaphoreWithIndex: index
> + "hack around the CoInterpreter/ObjectMemory split refactoring"
> + <doNotGenerate>
> + ^coInterpreter signalSemaphoreWithIndex: index!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>signalSemaphoreWithIndex: (in category 'process primitive support') -----
> signalSemaphoreWithIndex: index
> "This is a non-thread-safe simulation. See platforms/Cross/vm/sqExternalSemaphores.c
It could be made thread safe:
| originalResponses newRequests newResponses |
index <= 0 ifTrue: [^false].
index > externalSemaphoreSignalRequests size ifTrue: [
newRequests := Array new: 1 << index highBit withAll: 0.
newResponses := newRequests copy ].
originalResponses := externalSemaphoreSignalResponses.
[ index > externalSemaphoreSignalRequests size ] whileTrue: [
newRequests
replaceFrom: 1
to: externalSemaphoreSignalRequests size
with: externalSemaphoreSignalRequests
startingAt: 1.
newResponses
replaceFrom: 1
to: externalSemaphoreSignalResponses size
with: externalSemaphoreSignalResponses
startingAt: 1.
externalSemaphoreSignalResponses == originalResponses "This should always be true."
ifTrue: [
externalSemaphoreSignalRequests := newRequests.
externalSemaphoreSignalResponses := newResponses ]
ifFalse: [ originalResponses := externalSemaphoreSignalResponses ] ].
externalSemaphoreSignalRequests
at: index
put: (externalSemaphoreSignalRequests at: index) + 1.
^true
This is also a good example why CAS-style thread safety is a lot less
flexible.
Levente
> for the real code."
> index <= 0 ifTrue: [^false].
> index > externalSemaphoreSignalRequests size ifTrue:
> [| newRequests newResponses |
> newRequests := Array new: 1 << index highBit withAll: 0.
> newResponses := newRequests copy.
> newRequests
> replaceFrom: 1
> to: externalSemaphoreSignalRequests size
> with: externalSemaphoreSignalRequests
> startingAt: 1.
> newResponses
> replaceFrom: 1
> to: externalSemaphoreSignalResponses size
> with: externalSemaphoreSignalResponses
> + startingAt: 1.
> + externalSemaphoreSignalRequests := newRequests.
> + externalSemaphoreSignalResponses := newResponses].
> - startingAt: 1].
> externalSemaphoreSignalRequests
> at: index
> put: (externalSemaphoreSignalRequests at: index) + 1.
> ^true!
More information about the Vm-dev
mailing list