[Vm-dev] VM Maker: VMMaker.oscog-eem.2060.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Dec 31 01:35:43 UTC 2016 

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!

More information about the Vm-dev mailing list