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

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

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

Name: VMMaker.oscog-eem.2069
Author: eem
Time: 4 January 2017, 9:16:54.512363 am
UUID: f3417712-c17c-4755-92d6-f769cad5da06
Ancestors: VMMaker.oscog-eem.2068

Fix some memory access sends to self to be sends to objectMemory.

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

Item was changed:
  ----- Method: CoInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') -----
  unmarkAllFrames
  | thePage theFP methodField flags |
  <var: #thePage type: #'StackPage *'>
  <var: #theFP type: #'char *'>
  <inline: false>
  0 to: numStackPages - 1 do:
  [:i|
  thePage := stackPages stackPageAt: i.
  (stackPages isFree: thePage) ifFalse:
  [theFP := thePage  headFP.
+ [methodField := stackPages longAt: theFP + FoxMethod.
- [methodField := self longAt: theFP + FoxMethod.
  methodField asUnsignedInteger < objectMemory startOfMemory
  ifTrue:
  [(methodField bitAnd: 4) ~= 0 ifTrue:
  [self longAt: theFP + FoxMethod put: methodField - 4]]
  ifFalse:
+ [flags := stackPages longAt: theFP + FoxIFrameFlags.
- [flags := self longAt: theFP + FoxIFrameFlags.
   (flags bitAnd: 2) ~= 0 ifTrue:
+ [stackPages longAt: theFP + FoxIFrameFlags put: flags - 2]].
- [self longAt: theFP + FoxIFrameFlags put: flags - 2]].
   (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]!

Item was changed:
  ----- Method: CogVMSimulator>>clipboardRead:Into:At: (in category 'I/O primitives') -----
  clipboardRead: sz Into: actualAddress At: zeroBaseIndex
  | str |
  str := Clipboard clipboardText.
  1 to: sz do:
+ [:i | objectMemory byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!
- [:i | self byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!

Item was changed:
  ----- Method: CogVMSimulator>>printRumpCStackTo: (in category 'rump c stack') -----
  printRumpCStackTo: address
  self assert: (self isOnRumpCStack: address).
  heapBase - objectMemory wordSize
  to: address
  by: objectMemory wordSize negated
  do:
  [:addr|
+ self printHex: addr; tab; printHex: (objectMemory longAt: addr); cr]!
- self printHex: addr; tab; printHex: (self longAt: addr); cr]!

Item was removed:
- ----- Method: CogVMSimulator>>validOop: (in category 'testing') -----
- validOop: oop
- " Return true if oop appears to be valid "
- (oop bitAnd: 1) = 1 ifTrue: [^ true].  "Integer"
- (oop bitAnd: 3) = 0 ifFalse: [^ false].  "Uneven address"
- oop >= objectMemory endOfMemory ifTrue: [^ false].  "Out of range"
- "could test if within the first large freeblock"
- (self longAt: oop) = 4 ifTrue: [^ false].
- (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
- ^ true!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
  primitiveObjectPointsTo
  | rcvr thang lastField |
  thang := self stackTop.
  rcvr := self stackValue: 1.
  (objectMemory isIntegerObject: rcvr) ifTrue:
  [^self pop: 2 thenPushBool: false].
 
  lastField := self lastPointerOf: rcvr.
+ objectMemory baseHeaderSize to: lastField by: objectMemory bytesPerOop do:
- objectMemory baseHeaderSize to: lastField by: objectMemory wordSize do:
  [:i |
+ (objectMemory longAt: rcvr + i) = thang ifTrue:
- (self longAt: rcvr + i) = thang ifTrue:
  [^self pop: 2 thenPushBool: true]].
  self pop: 2 thenPushBool: false!

Item was changed:
  ----- Method: InterpreterPrimitives>>sizeFieldOfAlien: (in category 'primitive support') -----
  sizeFieldOfAlien: alienObj
  "Answer the first field of alienObj which is assumed to be an Alien of at least 8 bytes"
  <inline: true>
+ ^objectMemory longAt: alienObj + objectMemory baseHeaderSize!
- ^self longAt: alienObj + objectMemory baseHeaderSize!

Item was changed:
  ----- Method: InterpreterPrimitives>>startOfAlienData: (in category 'primitive support') -----
  startOfAlienData: oop
  "Answer the start of the Alien's data or fail if oop is not an Alien."
  <api>
  <returnTypeC: #'void *'>
  (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifFalse:
  [self primitiveFailFor: PrimErrBadArgument.
  ^0].
  ^self cCoerceSimple: ((self isDirectAlien: oop)
  ifTrue: [oop + objectMemory baseHeaderSize + objectMemory bytesPerOop]
+ ifFalse: [objectMemory longAt: oop + objectMemory baseHeaderSize + objectMemory bytesPerOop])
- ifFalse: [self longAt: oop + objectMemory baseHeaderSize + objectMemory bytesPerOop])
  to: #'void *'!

Item was removed:
- ----- Method: InterpreterSimulator>>integerAt: (in category 'memory access') -----
- integerAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^memory integerAt: (byteAddress // 4) + 1!

Item was removed:
- ----- Method: InterpreterSimulator>>integerAt:put: (in category 'memory access') -----
- integerAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- ^memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!

Item was changed:
  ----- Method: StackInterpreter>>checkForLastObjectOverwrite (in category 'simulation') -----
  checkForLastObjectOverwrite
  <doNotGenerate>
  | freeStart |
  checkAllocFiller ifTrue:
  [self assert: ((freeStart := objectMemory freeStart) >= objectMemory scavengeThreshold
+  or: [(objectMemory longAt: freeStart) = freeStart])]!
-  or: [(self longAt: freeStart) = freeStart])]!

Item was changed:
  ----- Method: StackInterpreter>>createActualMessageTo: (in category 'message sending') -----
  createActualMessageTo: lookupClass
  "Bundle up the selector, arguments and lookupClass into a Message object.
  In the process it pops the arguments off the stack, and pushes the message object.
  This can then be presented as the argument of e.g. #doesNotUnderstand:"
  | argumentArray message |
  <inline: false> "This is a useful break-point"
  self assert: ((objectMemory isImmediate: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]).
  self mnuBreakpoint: messageSelector receiver: nil.
  objectMemory hasSpurMemoryManagerAPI
  ifTrue:
  [argumentArray := objectMemory
  eeInstantiateSmallClassIndex: ClassArrayCompactIndex
  format: objectMemory arrayFormat
  numSlots: argumentCount.
  message := objectMemory
  eeInstantiateSmallClassIndex: ClassMessageCompactIndex
  format: objectMemory nonIndexablePointerFormat
  numSlots: MessageLookupClassIndex + 1]
  ifFalse:
  [argumentArray := objectMemory
  eeInstantiateSmallClass: (objectMemory splObj: ClassArray)
  numSlots: argumentCount.
  message := objectMemory
  eeInstantiateSmallClass: (objectMemory splObj: ClassMessage)
  numSlots: MessageLookupClassIndex + 1].
 
  "Since the array is new can use unchecked stores."
  (argumentCount - 1) * objectMemory bytesPerOop to: 0 by: objectMemory bytesPerOop negated do:
  [:i|
+ objectMemory longAt:  argumentArray + objectMemory baseHeaderSize + i put: self popStack].
- self longAt:  argumentArray + objectMemory baseHeaderSize + i put: self popStack].
  "Since message is new can use unchecked stores."
  objectMemory
  storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector;
  storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray;
  storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass.
 
  self push: message.
 
  argumentCount := 1!

Item was changed:
  ----- Method: StackInterpreter>>stringOf: (in category 'debug support') -----
  stringOf: oop
  <doNotGenerate>
  | size long nLongs chars |
  ^ String streamContents:
  [:strm |
  size := 128 min: (self stSizeOf: oop).
  nLongs := size-1//objectMemory wordSize+1.
  1 to: nLongs do:
+ [:i | long := objectMemory longAt: oop + objectMemory baseHeaderSize + (i-1*objectMemory wordSize).
- [:i | long := self longAt: oop + objectMemory baseHeaderSize + (i-1*objectMemory wordSize).
  chars := self charsOfLong: long.
  strm nextPutAll: (i=nLongs
  ifTrue: [chars copyFrom: 1 to: size-1\\objectMemory wordSize+1]
  ifFalse: [chars])]]!

Item was changed:
  ----- Method: StackInterpreter>>updateObjectsPostByteSwap (in category 'image save/restore') -----
  updateObjectsPostByteSwap
  "Byte-swap the words of all bytes objects in the image, including Strings, ByteArrays,
  and CompiledMethods. This returns these objects to their original byte ordering
  after blindly byte-swapping the entire image. For compiled  methods, byte-swap
  only their bytecodes part. Ensure floats are in platform-order."
  | swapFloatWords |
  swapFloatWords := objectMemory vmEndianness ~= imageFloatsBigEndian.
  self assert: ClassFloatCompactIndex ~= 0.
  objectMemory allObjectsDo:
  [:oop| | fmt wordAddr methodHeader temp |
  fmt := objectMemory formatOf: oop.
  fmt >= self firstByteFormat ifTrue: "oop contains bytes"
  [wordAddr := oop + objectMemory baseHeaderSize.
  fmt >= self firstCompiledMethodFormat ifTrue: "compiled method; start after methodHeader and literals"
+ [methodHeader := objectMemory longAt: oop + objectMemory baseHeaderSize.
- [methodHeader := self longAt: oop + objectMemory baseHeaderSize.
  wordAddr := wordAddr + (((objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart) * objectMemory bytesPerOop)].
  objectMemory reverseBytesFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)].
  fmt = self firstLongFormat ifTrue: "Bitmap, Float etc"
  [(swapFloatWords
   and: [(objectMemory compactClassIndexOf: oop) = ClassFloatCompactIndex])
  ifTrue:
+ [temp := objectMemory longAt: oop + objectMemory baseHeaderSize.
+ objectMemory longAt: oop + objectMemory baseHeaderSize put: (self longAt: oop + objectMemory baseHeaderSize + 4).
+ objectMemory longAt: oop + objectMemory baseHeaderSize + 4 put: temp]
- [temp := self longAt: oop + objectMemory baseHeaderSize.
- self longAt: oop + objectMemory baseHeaderSize put: (self longAt: oop + objectMemory baseHeaderSize + 4).
- self longAt: oop + objectMemory baseHeaderSize + 4 put: temp]
  ifFalse:
  [(objectMemory hasSpurMemoryManagerAPI not
   and: [objectMemory wordSize = 8]) ifTrue: "Object contains 32-bit half-words packed into 64-bit machine words."
  [wordAddr := oop + objectMemory baseHeaderSize.
  objectMemory reverseWordsFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)]]]]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
  primitiveObjectPointsTo
  "This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so.
  N.B.  Works forrectly for cogged methods too."
  | rcvr thang header fmt numSlots methodHeader |
  thang := self stackTop.
  rcvr := self stackValue: 1.
  (objectMemory isImmediate: rcvr) ifTrue:
  [^self pop: 2 thenPushBool: false].
 
  "Inlined version of lastPointerOf: for speed in determining if rcvr is a context."
  header := objectMemory baseHeader: rcvr.
  fmt := objectMemory formatOfHeader: header.
  (objectMemory isPointersFormat: fmt)
  ifTrue:
  [(fmt = objectMemory indexablePointersFormat
   and: [objectMemory isContextHeader: header])
  ifTrue:
  [(self isMarriedOrWidowedContext: rcvr) ifTrue:
  [self externalWriteBackHeadFramePointers.
  (self isStillMarriedContext: rcvr) ifTrue:
  [^self pop: 2
  thenPushBool: (self marriedContext: rcvr
  pointsTo: thang
  stackDeltaForCurrentFrame: 2)]].
  "contexts end at the stack pointer"
  numSlots := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr)]
  ifFalse:
  [numSlots := objectMemory numSlotsOf: rcvr]]
  ifFalse:
  [fmt < objectMemory firstCompiledMethodFormat "no pointers" ifTrue:
  [^self pop: 2 thenPushBool: false].
  "CompiledMethod: contains both pointers and bytes:"
  methodHeader := objectMemory methodHeaderOf: rcvr.
  methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true].
  numSlots := (objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart].
 
  self assert: numSlots - 1 * objectMemory bytesPerOop + objectMemory baseHeaderSize = (objectMemory lastPointerOf: rcvr).
  objectMemory baseHeaderSize
  to: numSlots - 1 * objectMemory bytesPerOop + objectMemory baseHeaderSize
  by: objectMemory bytesPerOop
  do: [:i|
+ (objectMemory longAt: rcvr + i) = thang ifTrue:
- (self longAt: rcvr + i) = thang ifTrue:
  [^self pop: 2 thenPushBool: true]].
  self pop: 2 thenPushBool: false!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') -----
  unmarkAllFrames
  | thePage theFP flags |
  <var: #thePage type: #'StackPage *'>
  <var: #theFP type: #'char *'>
  <inline: false>
  0 to: numStackPages - 1 do:
  [:i|
  thePage := stackPages stackPageAt: i.
  (stackPages isFree: thePage) ifFalse:
  [theFP := thePage  headFP.
+ [flags := objectMemory longAt: theFP + FoxFrameFlags.
- [flags := self longAt: theFP + FoxFrameFlags.
   (flags bitAnd: 2) ~= 0 ifTrue:
+ [objectMemory longAt: theFP + FoxFrameFlags put: flags - 2].
- [self longAt: theFP + FoxFrameFlags put: flags - 2].
   (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>clipboardRead:Into:At: (in category 'I/O primitives') -----
  clipboardRead: sz Into: actualAddress At: zeroBaseIndex
  | str |
  str := Clipboard clipboardText.
  1 to: sz do:
+ [:i | objectMemory byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!
- [:i | self byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!

Item was removed:
- ----- Method: StackInterpreterSimulator>>integerAt: (in category 'memory access') -----
- integerAt: byteAddress
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- self deprecated.
- ^objectMemory memory integerAt: (byteAddress // 4) + 1!

Item was removed:
- ----- Method: StackInterpreterSimulator>>integerAt:put: (in category 'memory access') -----
- integerAt: byteAddress put: a32BitValue
- "Note: Adjusted for Smalltalk's 1-based array indexing."
-
- self deprecated.
- ^objectMemory memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!

Item was removed:
- ----- Method: StackInterpreterSimulator>>validOop: (in category 'testing') -----
- validOop: oop
- " Return true if oop appears to be valid "
- (oop bitAnd: 1) = 1 ifTrue: [^ true].  "Integer"
- (oop bitAnd: 3) = 0 ifFalse: [^ false].  "Uneven address"
- oop >= objectMemory endOfMemory ifTrue: [^ false].  "Out of range"
- "could test if within the first large freeblock"
- (self longAt: oop) = 4 ifTrue: [^ false].
- (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
- ^ true!