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

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

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

Name: VMMaker.oscog-eem.2796
Author: eem
Time: 29 August 2020, 7:20:43.067441 pm
UUID: 28a85911-a957-43f5-9311-3434d5f7727c
Ancestors: VMMaker.oscog-eem.2795

Fix a few storePointer:...withValue: objectMemory nilObject's to be storePointerUnchecked:.

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

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 currently running, take it off
  its corresponding list. The primitive returns the list the receiver was previously on."
  | process myList |
  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.
  "XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
  but we can't easily so just do a quick check for nil which is the most common case."
  myList = objectMemory nilObject ifTrue:
  [^self primitiveFailFor: PrimErrBadReceiver].
  "Alas in Spur we need a read barrier"
  (objectMemory isForwarded: myList) ifTrue:
  [myList := objectMemory followForwarded: myList.
  objectMemory storePointer: MyListIndex ofObject: process withValue: myList].
  self removeProcess: process fromList: myList.
  self successful ifTrue:
+ [objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject.
- [objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject.
  self pop: 1 thenPush: myList]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveNewMethod (in category 'compiled methods') -----
  primitiveNewMethod
  | header bytecodeCount class size theMethod literalCount |
  header := self stackTop.
  bytecodeCount := self stackValue: 1.
  ((objectMemory isIntegerObject: header)
  and: [(objectMemory isIntegerObject: bytecodeCount)
  and: [(bytecodeCount := objectMemory integerValueOf: bytecodeCount) >= 0]]) ifFalse:
  [self primitiveFailFor: PrimErrBadArgument.
  ^self].
  class := self stackValue: 2.
  literalCount := objectMemory literalCountOfMethodHeader: header.
  size := literalCount + LiteralStart * objectMemory bytesPerOop + bytecodeCount.
  objectMemory hasSpurMemoryManagerAPI
  ifTrue:
  [theMethod := objectMemory instantiateCompiledMethodClass: class indexableSize: size.
  theMethod ifNil:
  [self primitiveFailFor: ((objectMemory isCompiledMethodFormat: (objectMemory instSpecOfClass: class))
  ifTrue: [PrimErrNoMemory]
  ifFalse: [PrimErrBadReceiver]).
  ^self]]
  ifFalse:
  [theMethod := objectMemory instantiateClass: class indexableSize: size].
  objectMemory storePointerUnchecked: HeaderIndex ofObject: theMethod withValue: header.
  1 to: literalCount do:
+ [:i | objectMemory storePointerUnchecked: i ofObject: theMethod withValue: objectMemory nilObject].
- [:i | objectMemory storePointer: i ofObject: theMethod withValue: objectMemory nilObject].
  self pop: 3 thenPush: theMethod!

Item was changed:
  ----- Method: InterpreterPrimitives>>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 currently running, take it off
  its corresponding list. The primitive returns the list the receiver was previously on."
  | process myList |
  process := self stackTop.
  process = self activeProcess ifTrue:
  [self pop: 1 thenPush: objectMemory nilObject.
  ^self transferTo: self wakeHighestPriority].
  myList := objectMemory fetchPointer: MyListIndex ofObject: process.
  "XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
  but we can't easily so just do a quick check for nil which is the most common case."
  myList = objectMemory nilObject ifTrue:
  [^self primitiveFailFor: PrimErrBadReceiver].
  "Alas in Spur we need a read barrier"
  (objectMemory isForwarded: myList) ifTrue:
  [myList := objectMemory followForwarded: myList.
  objectMemory storePointer: MyListIndex ofObject: process withValue: myList].
  self removeProcess: process fromList: myList.
  self successful ifTrue:
+ [objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject.
- [objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject.
  self pop: 1 thenPush: myList]!

Item was changed:
  ----- Method: StackInterpreter>>removeProcess:fromList: (in category 'process primitive support') -----
  removeProcess: aProcess fromList: aList
  "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).
  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 fetchPointer: NextLinkIndex ofObject: aProcess.
  self deny: (objectMemory isForwarded: nextLink).
  objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink.
  aProcess  = lastLink ifTrue:
  [objectMemory storePointerUnchecked: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]]
  ifFalse:
  [tempLink := firstLink.
  [self deny: (objectMemory isForwarded: tempLink).
   tempLink = objectMemory nilObject ifTrue:
  [self primitiveFail. ^self].
   nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink.
   nextLink = aProcess] whileFalse:
  [tempLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink].
  nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess.
  objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink.
  aProcess  = lastLink ifTrue:
  [objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink]].
+ objectMemory storePointerUnchecked: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject!
- objectMemory storePointer: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSignalAtMilliseconds (in category 'system control primitives') -----
  primitiveSignalAtMilliseconds
  "Cause the time semaphore, if one has been registered, to be
  signalled when the microsecond clock is greater than or equal to
  the given tick value. A tick value of zero turns off timer interrupts."
  | msecsObj msecs deltaMsecs sema limit |
  <var: #msecs type: #sqLong>
  <var: #deltaMsecs type: #sqLong>
  <var: #limit type: #sqLong>
  msecsObj := self stackTop.
  sema := self stackValue: 1.
  msecs := self positive32BitValueOf: msecsObj.
 
  self successful ifTrue:
  [(objectMemory isSemaphoreOop: sema) ifTrue:
  [objectMemory splObj: TheTimerSemaphore put: sema.
  deltaMsecs := msecs - (self ioMSecs bitAnd: MillisecondClockMask).
  limit := MillisecondClockMask >> 1.
  "Handle a roll-over that could happen in between image invocation of ioMSecs and this invocation.
   This will limit the maximum relative duration to MillisecondClockMask/2, about 3 days currently.
   Every delay longer than that limit may lead to undefined behavior (shorten delay, or no delay at all)"
  deltaMsecs > limit ifTrue: [deltaMsecs := deltaMsecs - MillisecondClockMask].
  nextWakeupUsecs := deltaMsecs > 0
  ifTrue: [self ioUTCMicroseconds + (deltaMsecs * 1000)]
  ifFalse: [self ioUTCMicroseconds].
  ^self pop: 2].
  sema = objectMemory nilObject ifTrue:
  [objectMemory
+ storePointerUnchecked: TheTimerSemaphore
- storePointer: TheTimerSemaphore
  ofObject: objectMemory specialObjectsOop
  withValue: objectMemory nilObject.
  nextWakeupUsecs := 0.
  ^self pop: 2]].
  self primitiveFailFor: PrimErrBadArgument!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSignalAtUTCMicroseconds (in category 'system control primitives') -----
  primitiveSignalAtUTCMicroseconds
  "Cause the time semaphore, if one has been registered, to be
  signalled when the microsecond clock is greater than or equal to
  the given tick value. A tick value of zero turns off timer interrupts."
  | usecsObj sema usecs |
  <var: #usecs type: #usqLong>
  usecsObj := self stackTop.
  sema := self stackValue: 1.
  usecs := self positive64BitValueOf: usecsObj.
  self successful ifTrue:
  [(objectMemory isSemaphoreOop: sema) ifTrue:
  [objectMemory splObj: TheTimerSemaphore put: sema.
  nextWakeupUsecs := usecs.
  ^self pop: 2].
  sema = objectMemory nilObject ifTrue:
  [objectMemory
+ storePointerUnchecked: TheTimerSemaphore
- storePointer: TheTimerSemaphore
  ofObject: objectMemory specialObjectsOop
  withValue: objectMemory nilObject.
  nextWakeupUsecs := 0.
  ^self pop: 2]].
  self primitiveFailFor: PrimErrBadArgument!