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

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

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

Name: VMMaker.oscog-eem.2763
Author: eem
Time: 23 June 2020, 10:37:04.443736 am
UUID: a710c685-e1fa-429e-a468-07d50de0aa86
Ancestors: VMMaker.oscog-nice.2762

MiscPrimitivePlugin: fix several uses of sizeOfSTArrayFromCPrimitive: that don't check for potential failure if e.g. invoked on a CompiledMethod.

Primitive infrastructure: consequently guard the various methodReturnXXX's with an assert to check that a primitive has not failed.

Also make sure that the SpurNBitCoMemoryManagers do not follow any reference to a Cog method in the first field of a CompiledMethod.

=============== Diff against VMMaker.oscog-nice.2762 ===============

Item was changed:
  ----- Method: InterpreterProxy>>methodReturnBool: (in category 'stack access') -----
  methodReturnBool: boolean
  "Sets the return value for a method"
+ self deny: self failed.
  self pop: argumentCount+1 thenPushBool: boolean.
  ^0!

Item was changed:
  ----- Method: InterpreterProxy>>methodReturnFloat: (in category 'stack access') -----
  methodReturnFloat: aFloat
  "Sets the return value for a method"
  <var: 'aFloat' type: #double>
+ self deny: self failed.
  self pop: argumentCount+1 thenPushFloat: aFloat.
  ^0!

Item was changed:
  ----- Method: InterpreterProxy>>methodReturnInteger: (in category 'stack access') -----
  methodReturnInteger: integer
  "Sets the return value for a method"
+ self deny: self failed.
  self pop: argumentCount+1 thenPushInteger: integer.
  ^0!

Item was changed:
  ----- Method: InterpreterProxy>>methodReturnReceiver (in category 'stack access') -----
  methodReturnReceiver
  "Sets the return value for a method"
+ self deny: self failed.
  self pop: argumentCount.
  ^0!

Item was changed:
  ----- Method: InterpreterProxy>>methodReturnString: (in category 'stack access') -----
  methodReturnString: aCString
  "Attempt to answer a ByteString for a given C string as the result of a primitive."
  <var: 'aCString' type: #'char *'>
+ self deny: self failed.
  aCString
  ifNil: [primFailCode := PrimErrOperationFailed]
  ifNotNil:
  [(self stringForCString: aCString)
  ifNil: [primFailCode := PrimErrNoMemory]
  ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]].
  ^0!

Item was changed:
  ----- Method: InterpreterProxy>>methodReturnValue: (in category 'stack access') -----
  methodReturnValue: oop
  "Sets the return value for a method"
+ self deny: self failed.
  self pop: argumentCount+1 thenPush: oop.
  ^0!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveCompareString (in category 'primitives') -----
  primitiveCompareString
  "ByteString (class) compare: string1 with: string2 collated: order"
  <export: true>
  | len1 len2 order string1 string2 orderOop string1Oop string2Oop |
 
  <var: 'order' type: #'unsigned char *'>
  <var: 'string1' type: #'unsigned char *'>
  <var: 'string2' type: #'unsigned char *'>
  orderOop := interpreterProxy stackValue: 0.
  string2Oop := interpreterProxy stackValue: 1.
  string1Oop := interpreterProxy stackValue: 2.
  ((interpreterProxy isBytes: orderOop)
  and: [(interpreterProxy isBytes: string2Oop)
  and: [interpreterProxy isBytes: string1Oop]]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  order := interpreterProxy firstIndexableField: orderOop.
  (interpreterProxy sizeOfSTArrayFromCPrimitive: order) < 256 ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  string1 := interpreterProxy firstIndexableField: string1Oop.
  string2 := interpreterProxy firstIndexableField: string2Oop.
  len1 := interpreterProxy sizeOfSTArrayFromCPrimitive: string1.
  len2 := interpreterProxy sizeOfSTArrayFromCPrimitive: string2.
+ interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  0 to: (len1 min: len2) - 1 do:
  [ :i | | c1 c2 |
  c1 := order at: (string1 at: i).
  c2 := order at: (string2 at: i).
  c1 = c2 ifFalse:
  [^interpreterProxy methodReturnInteger: (c1 < c2 ifTrue: [1] ifFalse: [3])]].
  interpreterProxy methodReturnInteger:
  (len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]])!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveCompressToByteArray (in category 'primitives') -----
  primitiveCompressToByteArray
  "Bitmap compress: bm toByteArray: ba"
  <export: true>
  | bm ba eqBytes i j k lowByte size destSize word |
  <var: 'ba' type: #'unsigned char *'>
  <var: 'bm' type: #'int *'>
  bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)]
  inSmalltalk: [interpreterProxy
  cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1))
  to: #'int *'].
  interpreterProxy failed ifTrue: [^nil].
  (interpreterProxy isBytes: (interpreterProxy stackValue: 0)) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  (interpreterProxy isOopImmutable: (interpreterProxy stackValue: 0)) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrNoModification].
  ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
  size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
  destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
+ interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported"
  i := self encodeInt: size in: ba at: 0.
  k := 0.
  [k < size] whileTrue:
  [word := bm at: k.
  lowByte := word bitAnd: 255.
  eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]].
  j := k.
  [j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1].
  j > k
  ifTrue:
  [eqBytes
  ifTrue:
  [i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i.
  ba at: i put: lowByte.
  i := i + 1]
  ifFalse:
  [i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i.
  i := self encodeBytesOf: word in: ba at: i].
  k := j + 1]
  ifFalse:
  [eqBytes
  ifTrue:
  [i := self encodeInt: 1 * 4 + 1 in: ba at: i.
  ba at: i put: lowByte.
  i := i + 1.
  k := k + 1]
  ifFalse:
  [[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1].
  j + 1 = size ifTrue: [j := j + 1].
  i := self encodeInt: j - k * 4 + 3 in: ba at: i.
  k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
  k := j]]].
  interpreterProxy methodReturnInteger: i!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveConvert8BitSigned (in category 'primitives') -----
  primitiveConvert8BitSigned
  "SampledSound (class) convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer"
  <export: true>
  | aByteArray aSoundBuffer arraySize byteArrayOop soundBufferOop |
 
  <var: 'aByteArray' type: #'unsigned char *'>
  <var: 'aSoundBuffer' type: #'unsigned short *'>
  byteArrayOop := interpreterProxy stackValue: 1.
  (interpreterProxy isBytes: byteArrayOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
  soundBufferOop := interpreterProxy stackValue: 0.
+ (interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrNoModification].
  aSoundBuffer := self
  cCode: [interpreterProxy arrayValueOf: soundBufferOop]
  inSmalltalk: [interpreterProxy
  cCoerce: (interpreterProxy arrayValueOf: soundBufferOop)
  to: #'unsigned short *'].
- interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- (interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
- [^interpreterProxy primitiveFailFor: PrimErrNoModification].
  arraySize := interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray.
+ interpreterProxy failed ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  (interpreterProxy byteSizeOf: soundBufferOop) < (2 * arraySize) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  0 to: arraySize - 1 do:
  [ :i | | s |
  s := aByteArray at: i.
  aSoundBuffer
  at: i
  put: (s > 127
  ifTrue: [s - 256 bitShift: 8]
  ifFalse: [s bitShift: 8])].
  interpreterProxy methodReturnReceiver!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveDecompressFromByteArray (in category 'primitives') -----
  primitiveDecompressFromByteArray
  "Bitmap decompress: bm fromByteArray: ba at: index"
  <export: true>
  | bm ba index i anInt code data end k n pastEnd |
  <var: 'ba' type: #'unsigned char *'>
  <var: 'bm' type: #'int *'>
  <var: 'anInt' type: #'unsigned int'>
  <var: 'code' type: #'unsigned int'>
  <var: 'data' type: #'unsigned int'>
  <var: 'n' type: #'unsigned int'>
  bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2)]
  inSmalltalk: [interpreterProxy
  cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2))
  to: #'int *'].
  (interpreterProxy isOopImmutable: (interpreterProxy stackValue: 2)) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrNoModification].
  (interpreterProxy isBytes: (interpreterProxy stackValue: 1)) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
  index := interpreterProxy stackIntegerValue: 0.
- interpreterProxy failed ifTrue: [^nil].
- i := index - 1.
- k := 0.
  end := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
  pastEnd := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
+ interpreterProxy failed ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ i := index - 1.
+ k := 0.
  [i < end] whileTrue:
  [anInt := ba at: i.
  i := i + 1.
  anInt <= 223 ifFalse:
  [anInt <= 254
  ifTrue:
  [anInt := anInt - 224 * 256 + (ba at: i).
  i := i + 1]
  ifFalse:
  [anInt := 0.
  1 to: 4 by: 1 do:
  [ :j | anInt := (anInt bitShift: 8) + (ba at: i).
  i := i + 1]]].
  n := anInt >> 2.
  k + n > pastEnd ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  code := anInt bitAnd: 3.
  "code = 0 ifTrue: [nil]."
  code = 1 ifTrue:
  [data := ba at: i.
  i := i + 1.
  data := data bitOr: (data bitShift: 8).
  data := data bitOr: (data bitShift: 16).
  1 to: n do:
  [ :j |
  bm at: k put: data.
  k := k + 1]].
  code = 2 ifTrue:
  [data := 0.
  1 to: 4 do:
  [ :j |
  data := (data bitShift: 8) bitOr: (ba at: i).
  i := i + 1].
  1 to: n do:
  [ :j |
  bm at: k put: data.
  k := k + 1]].
  code = 3 ifTrue:
  [1 to: n do:
  [ :m |
  data := 0.
  1 to: 4 do:
  [ :j |
  data := (data bitShift: 8) bitOr: (ba at: i).
  i := i + 1].
  bm at: k put: data.
  k := k + 1]]].
  interpreterProxy pop: interpreterProxy methodArgumentCount!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveFindFirstInString (in category 'primitives') -----
  primitiveFindFirstInString
  "ByteString (class) findFirstInString: aString inSet: inclusionMap  startingAt: start"
  <export: true>
 
  |  aString i inclusionMap stringSize aStringOop inclusionMapOop |
  <var: 'aString' type: #'unsigned char *'>
  <var: 'inclusionMap' type: #'unsigned char *'>
  aStringOop := interpreterProxy stackValue: 2.
  (interpreterProxy isBytes: aStringOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  inclusionMapOop :=  interpreterProxy stackValue: 1.
  (interpreterProxy isBytes: inclusionMapOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  i := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  i := i - 1. "Convert to 0-based index."
  i < 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  inclusionMap := interpreterProxy firstIndexableField: inclusionMapOop.
  (interpreterProxy sizeOfSTArrayFromCPrimitive: inclusionMap) ~= 256 ifTrue:
  [^interpreterProxy methodReturnInteger: 0].
  aString := interpreterProxy firstIndexableField: aStringOop.
  stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
+ interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  [i < stringSize and: [(inclusionMap at: (aString at: i)) = 0]] whileTrue:
  [i := i + 1].
  interpreterProxy methodReturnInteger: (i >= stringSize ifTrue: [0] ifFalse: [i + 1])!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveFindSubstring (in category 'primitives') -----
  primitiveFindSubstring
  "ByteString findSubstring: key in: body startingAt: start matchTable: matchTable"
  <export: true>
 
+ | body key keySize bodySize matchTable start bodyOop keyOop matchTableOop |
- | body key keySize matchTable start bodyOop keyOop matchTableOop |
  <var: #key type: #'unsigned char *'>
  <var: #body type: #'unsigned char *'>
  <var: #matchTable type: #'unsigned char *'>
  keyOop := interpreterProxy stackValue: 3.
  (interpreterProxy isBytes: keyOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  bodyOop := interpreterProxy stackValue: 2.
  (interpreterProxy isBytes: bodyOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  start := interpreterProxy stackIntegerValue: 1.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  matchTableOop := interpreterProxy stackValue: 0.
  (interpreterProxy isBytes: matchTableOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  matchTable := interpreterProxy firstIndexableField: matchTableOop.
  (interpreterProxy sizeOfSTArrayFromCPrimitive: matchTable) < 256 ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  key := interpreterProxy firstIndexableField: keyOop.
  (keySize := interpreterProxy sizeOfSTArrayFromCPrimitive: key) > 0 ifTrue:
  [keySize := keySize - 1. "adjust for zero relative indexes"
  start := start - 1 max: 0. "adjust for zero relative indexes"
+ body := interpreterProxy firstIndexableField: bodyOop.
+ bodySize := interpreterProxy sizeOfSTArrayFromCPrimitive: body.
+ interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ start to: bodySize - 1 - keySize do:
- body := interpreterProxy firstIndexableField: bodyOop.
- start to: (interpreterProxy sizeOfSTArrayFromCPrimitive: body) - 1 - keySize do:
  [ :startIndex | | index |
  index := 0.
  [(matchTable at: (body at: startIndex + index)) = (matchTable at: (key at: index))] whileTrue:
  [index = keySize ifTrue:
  [^interpreterProxy methodReturnInteger: startIndex + 1].
  index := index + 1]]].
  ^interpreterProxy methodReturnInteger: 0!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveIndexOfAsciiInString (in category 'primitives') -----
  primitiveIndexOfAsciiInString
  "ByteString indexOfAscii: anInteger inString: aString startingAt: start"
  <export: true>
 
+ | integerOop startOop anInteger aString start stringSize stringOop |
- | anInteger aString start stringSize aStringOop |
  <var: #aString type: #'unsigned char *'>
+ integerOop := interpreterProxy stackValue: 2.
+ stringOop := interpreterProxy stackValue: 1.
+ startOop := interpreterProxy stackValue: 0.
+ ((interpreterProxy isIntegerObject: integerOop)
+ and: [(interpreterProxy isIntegerObject: startOop)
+ and: [(interpreterProxy isBytes: stringOop)
+ and: [interpreterProxy isWordsOrBytes: stringOop]]]) ifFalse: "sizeOfSTArrayFromCPrimitive: is defined only for words or bytes"
- anInteger := interpreterProxy stackIntegerValue: 2.
- interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (start := interpreterProxy integerValueOf: startOop) >= 1 ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ anInteger := interpreterProxy integerValueOf: integerOop.
+ aString := interpreterProxy firstIndexableField: stringOop.
- aStringOop := interpreterProxy stackValue: 1.
- (interpreterProxy isBytes: aStringOop) ifFalse:
- [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- start := interpreterProxy stackIntegerValue: 0.
- interpreterProxy failed ifTrue:
- [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- start >= 1 ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
- aString := interpreterProxy firstIndexableField: aStringOop.
  stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
+ self deny: interpreterProxy failed.
  start - 1 to: stringSize - 1 do:
+ [:pos |
- [ :pos |
  (aString at: pos) = anInteger ifTrue:
  [^interpreterProxy methodReturnInteger: pos + 1]].
  ^interpreterProxy methodReturnInteger: 0!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveStringHash (in category 'primitives') -----
  primitiveStringHash
  "ByteArray (class) hashBytes: aByteArray startingWith: speciesHash"
  <export: true>
 
  | aByteArray hash byteArrayOop |
  <var: 'aByteArray' type: #'unsigned char *'>
  <var: 'hash' type: #'unsigned int'>
  hash := interpreterProxy stackIntegerValue: 0.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  byteArrayOop := interpreterProxy stackValue: 1.
+ ((interpreterProxy isBytes: byteArrayOop)
+ and: [interpreterProxy isWordsOrBytes: byteArrayOop]) ifFalse: "filters out CompiledMethods"
- (interpreterProxy isBytes: byteArrayOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
  0 to: (interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray) - 1 do:
  [ :pos |
  hash := hash + (aByteArray at: pos) * 16r19660D ].
  interpreterProxy methodReturnInteger: (hash bitAnd: 16r0FFFFFFF)!

Item was changed:
  ----- Method: MiscPrimitivePlugin>>primitiveTranslateStringWithTable (in category 'primitives') -----
  primitiveTranslateStringWithTable
  "ByteString (class) translate: aString from: start to: stop table: table"
  <export: true>
 
  | aString start stop table aStringOop tableOop |
  <var: #table type: #'unsigned char *'>
  <var: #aString type: #'unsigned char *'>
  aStringOop := interpreterProxy stackValue: 3.
  (interpreterProxy isBytes: aStringOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  (interpreterProxy isOopImmutable: aStringOop) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrNoModification].
  start := interpreterProxy stackIntegerValue: 2.
- interpreterProxy failed ifTrue:
- [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  stop := interpreterProxy stackIntegerValue: 1.
  interpreterProxy failed ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  tableOop := interpreterProxy stackValue: 0.
  (interpreterProxy isBytes: tableOop) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  aString := interpreterProxy firstIndexableField: aStringOop.
  (start >= 1 and: [stop <= (interpreterProxy sizeOfSTArrayFromCPrimitive: aString)]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  table := interpreterProxy firstIndexableField: tableOop.
  (interpreterProxy sizeOfSTArrayFromCPrimitive: table) < 256 ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ interpreterProxy failed ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  start - 1 to: stop - 1 do: [ :i | aString at: i put: (table at: (aString at: i))].
  interpreterProxy methodReturnReceiver!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'as yet unclassified') -----
+ followForwardedObjectFields: objOop toDepth: depth
+ "Follow pointers in the object to depth.
+ Answer if any forwarders were found.
+ How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
+ <api>
+ <inline: false>
+ | oop found fmt |
+ found := false.
+ self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
+ fmt := self formatOf: objOop.
+ "It is essential to skip the first field of a method because it may be a
+ reference to a Cog method in the method zone, not a real object at all."
+ ((self isCompiledMethodFormat: fmt)
+ ifTrue: [1]
+ ifFalse: [0])
+ to: (self numPointerSlotsOf: objOop format: fmt) - 1
+ do: [:i|
+ oop := self fetchPointer: i ofObject: objOop.
+ (self isNonImmediate: oop) ifTrue:
+ [(self isForwarded: oop) ifTrue:
+ [found := true.
+ oop := self followForwarded: oop.
+ self storePointer: i ofObject: objOop withValue: oop].
+ (depth > 0
+ and: [(self hasPointerFields: oop)
+ and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
+ [found := true]]].
+ ^found!

Item was added:
+ ----- Method: Spur64BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
+ followForwardedObjectFields: objOop toDepth: depth
+ "Follow pointers in the object to depth.
+ Answer if any forwarders were found.
+ How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
+ <api>
+ <inline: false>
+ | oop found fmt |
+ found := false.
+ self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
+ fmt := self formatOf: objOop.
+ "It is essential to skip the first field of a method because it may be a
+ reference to a Cog method in the method zone, not a real object at all."
+ ((self isCompiledMethodFormat: fmt)
+ ifTrue: [1]
+ ifFalse: [0])
+ to: (self numPointerSlotsOf: objOop format: fmt) - 1
+ do: [:i|
+ oop := self fetchPointer: i ofObject: objOop.
+ (self isNonImmediate: oop) ifTrue:
+ [(self isForwarded: oop) ifTrue:
+ [found := true.
+ oop := self followForwarded: oop.
+ self storePointer: i ofObject: objOop withValue: oop].
+ (depth > 0
+ and: [(self hasPointerFields: oop)
+ and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
+ [found := true]]].
+ ^found!

Item was changed:
  ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
  followForwardedObjectFields: objOop toDepth: depth
  "Follow pointers in the object to depth.
  Answer if any forwarders were found.
+ How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite."
- How to avoid cyclic structures?? A temproary mark bit?"
  <api>
  <inline: false>
  | oop found |
  found := false.
  self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
  0 to: (self numPointerSlotsOf: objOop) - 1 do:
  [:i|
  oop := self fetchPointer: i ofObject: objOop.
  (self isNonImmediate: oop) ifTrue:
  [(self isForwarded: oop) ifTrue:
  [found := true.
  oop := self followForwarded: oop.
  self storePointer: i ofObject: objOop withValue: oop].
  (depth > 0
  and: [(self hasPointerFields: oop)
  and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
  [found := true]]].
  ^found!

Item was changed:
  ----- Method: SpurMemoryManager>>numPointerSlotsOf: (in category 'object access') -----
  numPointerSlotsOf: objOop
  "Answer the number of pointer fields in the given object.
  Works with CompiledMethods, as well as ordinary objects."
  <api>
  <inline: true>
+ | fmt |
- | fmt contextSize numLiterals header |
  fmt := self formatOf: objOop.
+ ^self numPointerSlotsOf: objOop format: fmt!
- fmt <= self lastPointerFormat ifTrue:
- [(fmt = self indexablePointersFormat
-  and: [self isContextNonImm: objOop]) ifTrue:
- ["contexts end at the stack pointer"
- contextSize := coInterpreter fetchStackPointerOf: objOop.
- ^CtxtTempFrameStart + contextSize].
- ^self numSlotsOf: objOop  "all pointers"].
- fmt = self forwardedFormat ifTrue: [^1].
- fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
-
- "CompiledMethod: contains both pointers and bytes"
- header := self methodHeaderOf: objOop.
- numLiterals := self literalCountOfMethodHeader: header.
- ^numLiterals + LiteralStart!

Item was added:
+ ----- Method: SpurMemoryManager>>numPointerSlotsOf:format: (in category 'object access') -----
+ numPointerSlotsOf: objOop format: fmt
+ "Answer the number of pointer fields in the given object.
+ Works with CompiledMethods, as well as ordinary objects."
+ <inline: #always>
+ | contextSize numLiterals header |
+ fmt <= self lastPointerFormat ifTrue:
+ [(fmt = self indexablePointersFormat
+  and: [self isContextNonImm: objOop]) ifTrue:
+ ["contexts end at the stack pointer"
+ contextSize := coInterpreter fetchStackPointerOf: objOop.
+ ^CtxtTempFrameStart + contextSize].
+ ^self numSlotsOf: objOop  "all pointers"].
+ fmt = self forwardedFormat ifTrue: [^1].
+ fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
+
+ "CompiledMethod: contains both pointers and bytes"
+ header := self methodHeaderOf: objOop.
+ numLiterals := self literalCountOfMethodHeader: header.
+ ^numLiterals + LiteralStart!

Item was changed:
  ----- Method: StackInterpreter>>methodReturnBool: (in category 'plugin primitive support') -----
  methodReturnBool: boolean
  "Sets the return value for a method.  In the CoInterpreter we replace the cumbersome
  primResult machinery."
+ self deny: self failed.
  self pop: argumentCount+1 thenPushBool: boolean.
  ^0!

Item was changed:
  ----- Method: StackInterpreter>>methodReturnFloat: (in category 'plugin primitive support') -----
  methodReturnFloat: aFloat
  "Sets the return value for a method."
  <var: 'aFloat' type: #double>
+ self deny: self failed.
  self pop: argumentCount+1 thenPushFloat: aFloat.
  ^0!

Item was changed:
  ----- Method: StackInterpreter>>methodReturnInteger: (in category 'plugin primitive support') -----
  methodReturnInteger: integer
  "Sets the return value for a method.  In the CoInterpreter we replace the cumbersome
  primResult machinery."
+ self deny: self failed.
  self pop: argumentCount+1 thenPushInteger: integer.
  ^0!

Item was changed:
  ----- Method: StackInterpreter>>methodReturnReceiver (in category 'plugin primitive support') -----
  methodReturnReceiver
  "Sets the return value for a method"
+ self deny: self failed.
  self pop: argumentCount.
  ^0!

Item was changed:
  ----- Method: StackInterpreter>>methodReturnString: (in category 'plugin primitive support') -----
  methodReturnString: aCString
  "Attempt to answer a ByteString for a given C string as the result of a primitive."
  <var: 'aCString' type: #'char *'>
+ self deny: self failed.
  aCString
  ifNil: [primFailCode := PrimErrOperationFailed]
  ifNotNil:
  [(self stringForCString: aCString)
  ifNil: [primFailCode := PrimErrNoMemory]
  ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]].
  ^0!

Item was changed:
  ----- Method: StackInterpreter>>methodReturnValue: (in category 'plugin primitive support') -----
  methodReturnValue: oop
  "Sets the return value for a method.  In the CoInterpreter we replace the cumbersome
  primResult machinery."
+ self deny: self failed.
  self pop: argumentCount+1 thenPush: oop.
  ^0!