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

[commits at source.squeak.org]

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3130.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.3130
Author: eem
Time: 3 January 2022, 11:32:37.958591 am
UUID: 8816cfc7-c7cf-4ee0-88bf-da5d23785838
Ancestors: VMMaker.oscog-eem.3129

Interpreter:
Have primitiveSuspend fail for unresumable processes.
Beef up removeProcess:fromList: to follow forwarders in the list, allowing become on suspended processes (this weas definitely a bug), and have it nfail if it encounters a link that doesn't look like a process.

Slang: provide an x ordinate in the accessorDepthTable to make it easier to lookup accessor depths

=============== Diff against VMMaker.oscog-eem.3129 ===============

Item was changed:
  ----- Method: CCodeGenerator>>arrayInitializerCalled:for:sizeString:type: (in category 'utilities') -----
  arrayInitializerCalled: varName for: array sizeString: sizeStringOrNil type: cType
  	"array is a literal array or a CArray on some array."
  	^String streamContents:
  		[:s| | sequence lastLine index newLine atNewline |
  		sequence := array isCollection ifTrue: [array] ifFalse: [array object].
  		lastLine := index := 0.
  		newLine := [sequence size >= 20
  						ifTrue: [s cr; nextPutAll: '/*'; print: index; nextPutAll: '*/'; tab]
  						ifFalse: [s crtab: 2].
  					 lastLine := s position.
  					 atNewline := true].
  		s	nextPutAll: cType;
  			space;
  			nextPutAll: varName;
  			nextPut: $[.
  		sizeStringOrNil ifNotNil: [s nextPutAll: sizeStringOrNil].
  		s nextPutAll: '] = '.
  		sequence isString
  			ifTrue: [s nextPutAll: (self cLiteralFor: sequence)]
  			ifFalse:
  				[| mixedSigns |
  				"this is to align -ve and +ve integers nicely in the primitiveAccessorDepthTable"
  				mixedSigns := (sequence allSatisfy: [:element| element isInteger])
  								and: [(sequence anySatisfy: [:element| element < 0])
  								and: [sequence anySatisfy: [:element| element > 0]]].
  				 s nextPut: ${.
+ 				 sequence size > 20 ifTrue: "this provides an x ordinate for lookup in the primitiveAccessorDepthTable"
+ 					[s cr; next: 2 put: $/; next: (sequence size log: 10) floor + 3 put: Character space.
+ 					 0 to: 19 do:
+ 						[:n| s space. n < 10 ifTrue: [s space]. s print: n]].
  				 newLine value.
  				 sequence
  					do: [:element|
  						(mixedSigns and: [atNewline and: [element >= 0]]) ifTrue:
  							[s space].
  						(mixedSigns
  						 and: [element < 0
  						 and: [s peekLast = Character space]]) ifTrue:
  							[s skip: -1].
  						s nextPutAll: (self cLiteralFor: element). index := index + 1]
  					separatedBy:
  						[atNewline := false.
  						 s nextPut: $,.
  						 ((s position - lastLine) >= 76
  						 or: [(index \\ 20) = 0])
  							ifTrue: [newLine value]
  							ifFalse: [s space]].
  				 s crtab; nextPut: $}]]!

Item was changed:
  ----- Method: CoInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
  primitiveSuspend
  	"Primitive. Suspend the receiver, aProcess, such that it can be executed again
  	 by sending #resume. If the given process is not the active process, take it off
  	 its corresponding list. If the list was not its run queue assume it was on some
  	 condition variable (Semaphore, Mutex) and back up its pc to the send that
  	 invoked the wait state the process entered.  Hence when the process resumes
  	 it will reenter the wait state. Answer the list the receiver was previously on iff
  	 it was not active and not blocked, otherwise answer nil."
+ 	| process myList myContext ok |
- 	| process myList ok |
  	process := self stackTop.
  	process = self activeProcess ifTrue:
  		[| inInterpreter |
  		"We're going to switch process, either to an interpreted frame or a machine
  		 code frame. To know whether to return or enter machine code we have to
  		 know from whence we came.  We could have come from the interpreter,
  		 either directly or via a machine code primitive.  We could have come from
  		 machine code.  The instructionPointer tells us where from:"
  		self pop: 1 thenPush: objectMemory nilObject.
  		inInterpreter := instructionPointer >= objectMemory startOfMemory.
  		self transferTo: self wakeHighestPriority from: CSSuspend.
  		^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter].
+ 	myList := objectMemory fetchPointer: MyListIndex ofObject: process.
+ 	myContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: process.
+ 	((objectMemory isPointers: myList)
+ 	 and: [(objectMemory numSlotsOf: myList) > LastLinkIndex
+ 	 and: [(objectMemory isContext: myContext)
+ 	 and: [self isResumableContext: myContext]]]) ifFalse:
- 	"Alas in Spur we need a read barrier"
- 	myList := objectMemory followField: MyListIndex ofObject: process.
- 	myList = objectMemory nilObject ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	ok := self removeProcess: process fromList: myList.
  	ok ifFalse:
  		[^self primitiveFailFor: PrimErrOperationFailed].
  	objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject.
  	self assert: RevisedSuspend.
  	(RevisedSuspend
  	 and: [(objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag])
  		ifTrue:
  			[self backupProcess: process toBlockingSendTo: myList.
  			 self pop: 1 thenPush: objectMemory nilObject]
  		ifFalse:
  			[self pop: 1 thenPush: myList]!

Item was changed:
  ----- Method: StackInterpreter>>removeProcess:fromList: (in category 'process primitive support') -----
  removeProcess: aProcess fromList: aList 
+ 	"Attempt to remove a process from a linked list. Answer if the attempt succeeded."
- 	"Remove a given process from a linked list. May fail if aProcess is not on the list."
  	| firstLink lastLink nextLink tempLink |
  	self deny: (objectMemory isForwarded: aProcess).
  	self deny: (objectMemory isForwarded: aList).
+ 	"any process on the list could have been becomed, so use a read barrier..."
+ 	firstLink := objectMemory followField: FirstLinkIndex ofObject: aList.
+ 	lastLink := objectMemory followField: LastLinkIndex ofObject: aList.
+ 	aProcess = firstLink
- 	firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aList.
- 	lastLink := objectMemory fetchPointer: LastLinkIndex ofObject: aList.
- 	self deny: (objectMemory isForwarded: firstLink).
- 	self deny: (objectMemory isForwarded: lastLink).
- 	aProcess  = firstLink
  		ifTrue:
+ 			[nextLink := objectMemory followField: NextLinkIndex ofObject: aProcess.
- 			[nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess.
- 			 self deny: (objectMemory isForwarded: nextLink).
  			 objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink.
+ 			 aProcess = lastLink ifTrue:
- 			 aProcess  = lastLink ifTrue:
  				[objectMemory storePointerUnchecked: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]]
  		ifFalse:
  			[tempLink := firstLink.
+ 			 ["fail if any link doesn't look like a process..."
+ 			  ((objectMemory isPointers: tempLink)
+ 				and: [(objectMemory numSlotsOf: tempLink) > MyListIndex]) ifFalse:
- 			 [self deny: (objectMemory isForwarded: tempLink).
- 			  tempLink = objectMemory nilObject ifTrue:
  				[^false].
+ 			  nextLink := objectMemory followField: NextLinkIndex ofObject: tempLink.
- 			  nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink.
  			  nextLink = aProcess] whileFalse:
+ 				[tempLink := nextLink].
- 				[tempLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink].
  			 nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess.
  			 objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink.
+ 			 aProcess = lastLink ifTrue:
- 			 aProcess  = lastLink ifTrue:
  				[objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink]].
  	objectMemory storePointerUnchecked: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject.
  	^true!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
  primitiveSuspend
  	"Primitive. Suspend the receiver, aProcess, such that it can be executed again
  	 by sending #resume. If the given process is not the active process, take it off
  	 its corresponding list. If the list was not its run queue assume it was on some
  	 condition variable (Semaphore, Mutex) and back up its pc to the send that
  	 invoked the wait state the process entered.  Hence when the process resumes
  	 it will reenter the wait state. Answer the list the receiver was previously on iff
  	 it was not active and not blocked, otherwise answer nil."
+ 	| process myList myContext ok |
- 	| process myList ok |
  	process := self stackTop.
  	process = self activeProcess ifTrue:
  		[self pop: 1 thenPush: objectMemory nilObject.
  		 ^self transferTo: self wakeHighestPriority].
+ 	myList := objectMemory fetchPointer: MyListIndex ofObject: process.
+ 	myContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: process.
+ 	((objectMemory isPointers: myList)
+ 	 and: [(objectMemory numSlotsOf: myList) > LastLinkIndex
+ 	 and: [(objectMemory isContext: myContext)
+ 	 and: [self isResumableContext: myContext]]]) ifFalse:
- 	"Alas in Spur we need a read barrier"
- 	myList := objectMemory followField: MyListIndex ofObject: process.
- 	myList = objectMemory nilObject ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	ok := self removeProcess: process fromList: myList.
  	ok ifFalse:
  		[^self primitiveFailFor: PrimErrOperationFailed].
  	objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject.
  	self assert: RevisedSuspend.
  	(RevisedSuspend
  	 and: [(objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag])
  		ifTrue:
  			[self backupProcess: process toBlockingSendTo: myList.
  			 self pop: 1 thenPush: objectMemory nilObject]
  		ifFalse:
  			[self pop: 1 thenPush: myList]!