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.
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 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!