VM Maker: VMMaker.oscog-eem.2060.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
7 messages Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-eem.2060.mcz

commits-2
 
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!

Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.2060.mcz

Levente Uzonyi
 
On Sat, 31 Dec 2016, [hidden email] 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!
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.2060.mcz

Eliot Miranda-2
 
Hi Levente,

    thanks!!

On Sat, Dec 31, 2016 at 8:48 AM, Levente Uzonyi <[hidden email]> wrote:

On Sat, 31 Dec 2016, [hidden email] wrote:
[snip] 

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

I wonder would you be interested in taking a look at the real code in platforms/Cross/vm/sqExternalSemaphores.c?  I have a lock-free implementation of signalling, but no lock-free implementation of growing the sequence of signal requests, and hence the ugly and annoying need to specify a maximum size to the external signal requests table.  It would be lovely to say good bye to this :-)



         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!

Yes, nice.  The final at:put: is not thread-safe but your code is far better than the original.  I've included it and will commit soon.  Happy new year!

_,,,^..^,,,_
best, Eliot
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.2060.mcz

Levente Uzonyi
 
Hi Eliot,

I'm no expert in C programming, but I suppose a global counter could be
used to ensure that no other threads have modified the array before
swapping the pointers.

Btw, I thought that object pinning would make it possible to get rid of
the external semaphore table altogether. We need different plugin code for
that, but I think it would be simpler and more efficient.

Why is #at:put: not thread-safe? Isn't it a primitive, so that no
suspension point occurs provided both arguments are valid?

Happy New Year!

Levente
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.2060.mcz

Eliot Miranda-2
 
Hi Levente,

On Sat, Dec 31, 2016 at 11:45 AM, Levente Uzonyi <[hidden email]> wrote:

Hi Eliot,

I'm no expert in C programming, but I suppose a global counter could be used to ensure that no other threads have modified the array before swapping the pointers.

I think one uses exactly the strategy you used in the Smalltalk code, namely:
    if the structure needs growing, create a grown initialised copy, and then do a test-and-set to update the pointer.
 
Btw, I thought that object pinning would make it possible to get rid of the external semaphore table altogether. We need different plugin code for that, but I think it would be simpler and more efficient.

Well, I think pinning should help with a number of things.  But I don't see how it suffices here.  Making signal thread-safe is probably quite difficult, so the indirect request signal/grant signal scheme that the external semaphore table provides is convenient.  What am I missing?

Why is #at:put: not thread-safe? Isn't it a primitive, so that no suspension point occurs provided both arguments are valid?

Ah, good point!  That's not obvious :-).  I'll change my comment :-)  Cool, man!

 
Happy New Year!

Levente

Have a great year!  And good wishes to everyone!

_,,,^..^,,,_
best, Eliot
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.2060.mcz

Levente Uzonyi
 
Hi Eliot,

On Sat, 31 Dec 2016, Eliot Miranda wrote:

> I think one uses exactly the strategy you used in the Smalltalk code, namely:
>    if the structure needs growing, create a grown initialised copy, and then do a test-and-set to update the pointer.

That way you would miss the updates of existing semaphores during the
copy.
And this is what I think a global counter could prevent. Increment the
counter on each semaphore update. If its value has changed during
copying, then the copy will have to be repeated.

> Well, I think pinning should help with a number of things.  But I don't see how it suffices here.  Making signal thread-safe is probably quite difficult, so the indirect request signal/grant signal scheme
> ,that the external semaphore table provides is convenient.  What am I missing?

If the Semaphores were pinned, then their address could be used direcly
from the plugin code to signal them. So, I think we wouldn't need the
table. Perhaps there's something else this table does I'm not aware of.

Levente
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.2060.mcz

Eliot Miranda-2
 
Hi Levente,

> On Jan 1, 2017, at 6:41 AM, Levente Uzonyi <[hidden email]> wrote:
>
> Hi Eliot,
>
>> On Sat, 31 Dec 2016, Eliot Miranda wrote:
>>
>> I think one uses exactly the strategy you used in the Smalltalk code, namely:
>>     if the structure needs growing, create a grown initialised copy, and then do a test-and-set to update the pointer.
>
> That way you would miss the updates of existing semaphores during the copy.
> And this is what I think a global counter could prevent. Increment the counter on each semaphore update. If its value has changed during copying, then the copy will have to be repeated.

Makes sense.

>> Well, I think pinning should help with a number of things.  But I don't see how it suffices here.  Making signal thread-safe is probably quite difficult, so the indirect request signal/grant signal scheme
>> ,that the external semaphore table provides is convenient.  What am I missing?
>
> If the Semaphores were pinned, then their address could be used direcly from the plugin code to signal them. So, I think we wouldn't need the table. Perhaps there's something else this table does I'm not aware of.

The signal primitive is not thread-safe; it can only be invoked at a suspension point.  The external semaphore table safely asynchronously requests signals which are later performed by the vm at a safe point (the checkInterrupts routine).

> Levente