On Sat, 31 Dec 2016, commits@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].
externalSemaphoreSignalRequests at: index put: (externalSemaphoreSignalRequests at: index) + 1. ^true!startingAt: 1].