VM Maker: VMMaker.oscogSPC-eem.2118.mcz

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

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

Name: VMMaker.oscogSPC-eem.2118
Author: eem
Time: 30 January 2017, 12:36:15.524891 pm
UUID: 240e5693-afd5-4976-9230-d1fc4bf3c4b0
Ancestors: VMMaker.oscogSPC-eem.2117

SpurPlanningCompactor:
freeFrom:upTo:previousPin: must resect the limit it is given and not free beyond it.  Doing so causes double freeing.

updateSavedFirstFieldsSpaceIfNecessary must not reset the free space carefully built up by previous compaction passes.

noMobileObjectsFrom: doesn't need to be inlined and is more helpful for debugging if not.

SpurMemoryManager:
resetFreeLists should reset the freeListsMask! (old bug)

Have printFreeChunk:printAsTreeNode: print the address after for tree chunks.

Put a limit on valid class indices in the assert in classAtIndex:

Cogit:
Rename offsetCacheTagAndCouldBeObjectAt:annotation:into: to the more accurate entryCacheTagAndCouldBeObjectAt:annotation:into: and extract entryPointTagIsSelector: for use below.

Fix the check for valid selectors for 64-bits (unlinked cacheTags are literal/specialSelector indices) in checkIfValidOopRefAndTarget:pc:cogMethod:.

Simulator:
Print all those NOT FOUNDs to the right transcript.

=============== Diff against VMMaker.oscogSPC-eem.2117 ===============

Item was changed:
  ----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  | name pathName arrayNilOrSymbol result |
  name := self stringOf: self stackTop.
  pathName := self stringOf: (self stackValue: 1).
 
  "temporary work-around to make it work in Pharo..."
  self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ].
 
  self successful ifFalse:
  [^self primitiveFail].
 
  arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name.
  arrayNilOrSymbol ifNil:
  [self pop: 3 thenPush: objectMemory nilObject.
  ^self].
  arrayNilOrSymbol isArray ifFalse:
  ["arrayNilOrSymbol ~~ #primFailed ifTrue:
  [self halt]. "
+ self transcript show: name, ' NOT FOUND'.
- Transcript show: name, ' NOT FOUND'.
  ^self primitiveFail].
 
  result := PharoVM
  ifTrue:
  [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5)
  posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ]
  ifFalse:
  [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ].
  self pop: 3 thenPush: result!

Item was changed:
  ----- Method: Cogit>>checkIfValidOopRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidOopRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
  "Check for a valid object reference, if any, at a map entry.  Answer a code unique to each error for debugging."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | literal entryPoint |
  annotation = IsObjectReference ifTrue:
  [literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (self asserta: (objectRepresentation checkValidOopReference: literal)) ifFalse:
  [^1].
  ((objectRepresentation couldBeObject: literal)
  and: [objectMemory isReallyYoungObject: literal]) ifTrue:
  [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  [^2]]].
 
  NewspeakVM ifTrue:
  [annotation = IsNSSendCall ifTrue:
  [| nsSendCache classTag enclosingObject nsTargetMethod |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  (self asserta: (objectRepresentation checkValidOopReference: nsSendCache selector)) ifFalse:
  [^9].
  classTag := nsSendCache classTag.
  (self asserta: (classTag = 0 or: [objectRepresentation validInlineCacheTag: classTag])) ifFalse:
  [^10].
  enclosingObject := nsSendCache enclosingObject.
  (self asserta: (enclosingObject = 0 or: [objectRepresentation checkValidOopReference: enclosingObject])) ifFalse:
  [^11].
  entryPoint := nsSendCache target.
  entryPoint ~= 0 ifTrue: [
  nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  (self asserta: (nsTargetMethod cmType = CMMethod)) ifFalse:
  [^12]]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
  [^3].
+ self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
+ [:entryPt :cacheTag :tagCouldBeObject|
+ entryPoint := entryPt.
- self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [:offset :cacheTag :tagCouldBeObject|
  tagCouldBeObject
  ifTrue:
  [(objectRepresentation couldBeObject: cacheTag)
  ifTrue:
  [(self asserta: (objectRepresentation checkValidOopReference: cacheTag)) ifFalse:
  [^4]]
  ifFalse:
  [(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
  [^5]].
  ((objectRepresentation couldBeObject: cacheTag)
  and: [objectMemory isReallyYoungObject: cacheTag]) ifTrue:
  [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  [^6]]]
  ifFalse:
+ [(self inlineCacheTagsAreIndexes
+  and: [self self entryPointTagIsSelector: entryPoint])
+ ifTrue:
+ [cacheTag signedIntFromLong < 0
+ ifTrue:
+ [cacheTag signedIntFromLong negated > NumSpecialSelectors ifTrue:
+ [^7]]
+ ifFalse:
+ [cacheTag >= (objectMemory literalCountOf: enumeratingCogMethod methodObject) ifTrue:
+ [^8]]]
+ ifFalse:
+ [(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
+ [^9]]]].
- [(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
- [^7]]].
- entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase ifTrue:
  ["It's a linked send; find which kind."
  self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  (self asserta: (targetMethod cmType = CMMethod
    or: [targetMethod cmType = CMClosedPIC
    or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
+ [^10]]]].
- [^8]]]].
  ^0 "keep scanning"!

Item was added:
+ ----- Method: Cogit>>entryCacheTagAndCouldBeObjectAt:annotation:into: (in category 'in-line cacheing') -----
+ entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into: trinaryBlock
+ "Evaluate trinaryBlock with the entryPoint, inline cache tag and whether the cache
+ tag could be an object, for the send at mcpc with annotation annotation."
+ <inline: true>
+ | cacheTag entryPoint tagCouldBeObj |
+ cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
+ entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
+ "in-line cache tags are the selectors of sends if sends are unlinked,
+ the selectors of super sends (entry offset = cmNoCheckEntryOffset),
+ the selectors of open PIC sends (entry offset = cmEntryOffset, target is an Open PIC)
+ or in-line cache tags (classes, class indices, immediate bit patterns, etc).
+ Note that selectors can be immediate so there is no guarantee that they
+ are markable/remappable objects."
+ tagCouldBeObj := self inlineCacheTagsAreIndexes not
+ and: [objectRepresentation inlineCacheTagsMayBeObjects
+ or: [self entryPointTagIsSelector: entryPoint]].
+ trinaryBlock
+ value: entryPoint
+ value: cacheTag
+ value: tagCouldBeObj!

Item was added:
+ ----- Method: Cogit>>entryPointTagIsSelector: (in category 'in-line cacheing') -----
+ entryPointTagIsSelector: entryPoint
+ "Answer if the entryPoint's tag is expected to be a selector reference, as opposed to a class tag."
+ ^entryPoint < methodZoneBase
+ or: [(entryPoint bitAnd: entryPointMask) = uncheckedEntryAlignment
+ or: [(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
+ and: [(self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *') cmType = CMOpenPIC]]]!

Item was changed:
  ----- Method: Cogit>>markLiterals:pc:method: (in category 'garbage collection') -----
  markLiterals: annotation pc: mcpc method: cogMethod
  "Mark and trace literals.
  Additionally in Newspeak, void push implicits that have unmarked classes."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | literal |
  annotation = IsObjectReference ifTrue:
  [literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (objectRepresentation
  markAndTraceLiteral: literal
  in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  atpc: mcpc asUnsignedInteger) ifTrue:
  [codeModified := true]].
 
  NewspeakVM ifTrue:
  [annotation = IsNSSendCall ifTrue:
  [| nsSendCache sel eo |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  sel := nsSendCache selector.
  (objectMemory isForwarded: sel)
  ifFalse: [objectMemory markAndTrace: sel]
  ifTrue: [sel := objectMemory followForwarded: literal.
  nsSendCache selector: sel.
  self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
  eo := nsSendCache enclosingObject.
  eo ~= 0 ifTrue:
  [(objectMemory isForwarded: eo)
  ifFalse: [objectMemory markAndTrace: eo]
  ifTrue: [eo := objectMemory followForwarded: literal.
  nsSendCache enclosingObject: eo.
  self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
+ [self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:entryPoint :cacheTag :tagCouldBeObj |
  tagCouldBeObj ifTrue:
  [(objectRepresentation
  markAndTraceCacheTagLiteral: cacheTag
  in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  atpc: mcpc asUnsignedInteger) ifTrue:
  ["cacheTag is selector" codeModified := true]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>markLiteralsAndUnlinkIfUnmarkedSend:pc:method: (in category 'garbage collection') -----
  markLiteralsAndUnlinkIfUnmarkedSend: annotation pc: mcpc method: cogMethod
  "Mark and trace literals.  Unlink sends that have unmarked cache tags or targets."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | literal |
  annotation = IsObjectReference ifTrue:
  [literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (objectRepresentation
  markAndTraceLiteral: literal
  in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  atpc: mcpc asUnsignedInteger) ifTrue:
  [codeModified := true]].
 
  NewspeakVM ifTrue:
  [annotation = IsNSSendCall ifTrue:
  [| nsSendCache entryPoint targetMethod sel eo |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  entryPoint := nsSendCache target.
  entryPoint ~= 0 ifTrue: "Send is linked"
  [targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  (self markAndTraceOrFreeCogMethod: targetMethod
  firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger) ifTrue:
  [self voidNSSendCache: nsSendCache]].
  sel := nsSendCache selector.
  (objectMemory isForwarded: sel)
  ifFalse: [objectMemory markAndTrace: sel]
  ifTrue: [sel := objectMemory followForwarded: literal.
  nsSendCache selector: sel.
  self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
  eo := nsSendCache enclosingObject.
  eo ~= 0 ifTrue:
  [(objectMemory isForwarded: eo)
  ifFalse: [objectMemory markAndTrace: eo]
  ifTrue: [eo := objectMemory followForwarded: literal.
  nsSendCache enclosingObject: eo.
  self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
+ [self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:entryPoint :cacheTag :tagCouldBeObj | | cacheTagMarked |
  cacheTagMarked := tagCouldBeObj and: [objectRepresentation cacheTagIsMarked: cacheTag].
  entryPoint > methodZoneBase
  ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  (cacheTagMarked not
   or: [self markAndTraceOrFreeCogMethod: targetMethod
  firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger]) ifTrue:
  ["Either the cacheTag is unmarked (e.g. new class) or the target
   has been freed (because it is unmarked), so unlink the send."
  self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable.
  objectRepresentation
  markAndTraceLiteral: targetMethod selector
  in: targetMethod
  at: (self addressOf: targetMethod selector put: [:val| targetMethod selector: val])]]]
  ifFalse:  "cacheTag is selector"
  [(objectRepresentation
  markAndTraceCacheTagLiteral: cacheTag
  in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  atpc: mcpc asUnsignedInteger) ifTrue:
  [codeModified := true]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>markYoungObjects:pc:method: (in category 'garbage collection') -----
  markYoungObjects: annotation pc: mcpc method: cogMethod
  "Mark and trace young literals."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | literal |
  annotation = IsObjectReference ifTrue:
  [literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  objectRepresentation markAndTraceLiteralIfYoung: literal].
 
  NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
  [| nsSendCache |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  objectRepresentation markAndTraceLiteralIfYoung: nsSendCache selector.
  nsSendCache enclosingObject ~= 0 ifTrue:
  [objectRepresentation markAndTraceLiteralIfYoung: nsSendCache enclosingObject]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
+ [self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:entryPoint :cacheTag :tagCouldBeObj |
  tagCouldBeObj ifTrue:
  [objectRepresentation markAndTraceLiteralIfYoung: cacheTag]]].
 
  ^0 "keep scanning"!

Item was removed:
- ----- Method: Cogit>>offsetCacheTagAndCouldBeObjectAt:annotation:into: (in category 'in-line cacheing') -----
- offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into: trinaryBlock
- "Evaluate trinaryBlock with the entry, inline cache tag and whether the cache
- tag could be an object, for the send at mcpc with annotation annotation."
- <inline: true>
- | cacheTag entryPoint tagCouldBeObj |
- cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
- entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
- "in-line cache tags are the selectors of sends if sends are unlinked,
- the selectors of super sends (entry offset = cmNoCheckEntryOffset),
- the selectors of open PIC sends (entry offset = cmEntryOffset, target is an Open PIC)
- or in-line cache tags (classes, class indices, immediate bit patterns, etc).
- Note that selectors can be immediate so there is no guarantee that they
- are markable/remappable objects."
- tagCouldBeObj := self inlineCacheTagsAreIndexes not
- and: [objectRepresentation inlineCacheTagsMayBeObjects
- or: [entryPoint < methodZoneBase
- or: [(entryPoint bitAnd: entryPointMask) = uncheckedEntryAlignment
- or: [(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
- and: [(self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *') cmType = CMOpenPIC]]]]].
- trinaryBlock
- value: entryPoint
- value: cacheTag
- value: tagCouldBeObj!

Item was changed:
  ----- Method: Cogit>>remapIfObjectRef:pc:hasYoung: (in category 'garbage collection') -----
  remapIfObjectRef: annotation pc: mcpc hasYoung: hasYoungPtr
  <var: #mcpc type: #'char *'>
  <var: #targetMethod type: #'CogMethod *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  annotation = IsObjectReference ifTrue:
  [| literal mappedLiteral |
  literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (objectRepresentation couldBeObject: literal) ifTrue:
  [mappedLiteral := objectRepresentation remapObject: literal.
  literal ~= mappedLiteral ifTrue:
  [literalsManager storeLiteral: mappedLiteral atAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  codeModified := true].
  (hasYoungPtr ~= 0
   and: [objectMemory isYoung: mappedLiteral]) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
 
  NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
  [| nsSendCache oop mappedOop |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc.
  oop := nsSendCache selector.
  mappedOop := objectRepresentation remapObject: oop.
  oop ~= mappedOop ifTrue:
  [nsSendCache selector: mappedOop.
  (hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
  oop := nsSendCache enclosingObject.
  oop ~= 0 ifTrue: [
  mappedOop := objectRepresentation remapObject: oop.
  oop ~= mappedOop ifTrue:
  [nsSendCache enclosingObject: mappedOop.
  (hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
  ^0 "keep scanning"]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
+ [self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:entryPoint :cacheTag :tagCouldBeObj | | mappedCacheTag |
  (tagCouldBeObj
   and: [objectRepresentation couldBeObject: cacheTag]) ifTrue:
  [mappedCacheTag := objectRepresentation remapObject: cacheTag.
  cacheTag ~= mappedCacheTag ifTrue:
  [backEnd rewriteInlineCacheTag: mappedCacheTag at: mcpc asUnsignedInteger.
  codeModified := true].
  (hasYoungPtr ~= 0
   and: [objectMemory isYoung: mappedCacheTag]) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
  hasYoungPtr ~= 0 ifTrue:
  ["Since the unlinking routines may rewrite the cacheTag to the send's selector, and
   since they don't have the cogMethod to hand and can't add it to youngReferrers,
   the method must remain in youngReferrers if the targetMethod's selector is young."
  entryPoint > methodZoneBase ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :ignored|
  (objectMemory isYoung: targetMethod selector) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]]].
  ^0 "keep scanning"!

Item was changed:
  ----- Method: SpurMemoryManager>>classAtIndex: (in category 'class table') -----
  classAtIndex: classIndex
  <api>
  | classTablePage |
+ self assert: (classIndex >= 0 and: [classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun and: [classIndex <= self classIndexMask]]]).
- self assert: (classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun]).
  classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift
  ofObject: hiddenRootsObj.
  classTablePage = nilObj ifTrue:
  [^nil].
  ^self
  fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask)
  ofObject: classTablePage!

Item was changed:
  ----- Method: SpurMemoryManager>>printFreeChunk:printAsTreeNode: (in category 'debug printing') -----
  printFreeChunk: freeChunk printAsTreeNode: printAsTreeNode
  | numBytes |
  numBytes := self bytesInObject: freeChunk.
  coInterpreter
+ print: 'freeChunk '; printHexPtrnp: freeChunk.
+ printAsTreeNode ifTrue:
+ [coInterpreter print: ' - '; printHexPtrnp:(self addressAfter: freeChunk)].
+ coInterpreter
- print: 'freeChunk '; printHexPtrnp: freeChunk;
  print: ' bytes '; printNum: numBytes;
  print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
  ofFreeChunk: freeChunk).
  (numBytes >= (self numFreeLists * self allocationUnit)
  and: [printAsTreeNode]) ifTrue:
  [coInterpreter
  print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
  ofFreeChunk: freeChunk);
  print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
  ofFreeChunk: freeChunk);
  print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
  ofFreeChunk: freeChunk)].
  coInterpreter cr!

Item was changed:
  ----- Method: SpurMemoryManager>>resetFreeListHeads (in category 'free space') -----
  resetFreeListHeads
+ freeListsMask := 0.
  0 to: self numFreeLists - 1 do:
  [:i| freeLists at: i put: 0]!

Item was changed:
  ----- Method: SpurPlanningCompactor>>freeFrom:upTo:previousPin: (in category 'private') -----
  freeFrom: toFinger upTo: limit previousPin: previousPinOrNil
  "Free from toFinger up to limit, dealing with a possible intervening run of pinned objects starting at previousPinOrNil."
  <inline: false>
  <var: 'limit' type: #usqInt>
  <var: 'toFinger' type: #usqInt>
  <var: 'previousPinOrNil' type: #usqInt>
  | effectiveToFinger pin nextUnpinned start seg |
  <var: 'nextUnpinned' type: #usqInt>
  <var: #seg type: #'SpurSegmentInfo *'>
  self cCode: [] inSmalltalk:
  [coInterpreter cr; cr; print: 'freeing at '; printHexnp: toFinger; print: ' up to '; printHexnp: limit; print: ' pin '; printHexnp: previousPinOrNil; cr].
  effectiveToFinger := toFinger.
  pin := previousPinOrNil.
  "If the range toFinger to limit spans segments but there is no pin (as when freeing to the end of memory)
  segment boundaries must still be observed.  So in this case use the nearest bridge above toFinger as the pin."
  pin ifNil:
  [seg := manager segmentManager segmentContainingObj: toFinger.
+ self deny: seg isNil.
  seg segLimit < limit ifTrue:
  [pin := manager segmentManager bridgeFor: seg]].
+ [pin notNil and: [pin < limit]] whileTrue:
- [pin notNil] whileTrue:
  [(start := manager startOfObject: pin) > toFinger ifTrue:
  [manager addFreeChunkWithBytes: start - effectiveToFinger at: effectiveToFinger].
  nextUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pin.
  nextUnpinned >= limit ifTrue:
  [^self].
  effectiveToFinger := manager startOfObject: nextUnpinned.
  pin := self findNextMarkedPinnedAfter: nextUnpinned].
  limit > effectiveToFinger ifTrue:
  [manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger]!

Item was changed:
  ----- Method: SpurPlanningCompactor>>noMobileObjectsFrom: (in category 'private') -----
  noMobileObjectsFrom: mobileObj
+ <inline: false>
  manager allOldSpaceEntitiesFrom: mobileObj do:
  [:o|
  ((manager isMarked: o) and: [(manager isPinned: o) not]) ifTrue:
  [^false]].
  ^true!

Item was changed:
  ----- Method: SpurPlanningCompactor>>updateSavedFirstFieldsSpaceIfNecessary (in category 'space management') -----
  updateSavedFirstFieldsSpaceIfNecessary
  "If savedFirstFieldsSpace is a free chunk then it may need to be repositioned if there is more than one pass."
  <inline: true>
  self savedFirstFieldsSpaceInFreeChunk ifTrue:
  [self useFreeChunkForSavedFirstFieldsSpace: manager findLargestFreeChunk].
 
+ savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop!
- savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop.
- manager resetFreeListHeads!

Item was changed:
  ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  | name pathName arrayNilOrSymbol result |
  name := self stringOf: self stackTop.
  pathName := self stringOf: (self stackValue: 1).
 
  "temporary work-around to make it work in Pharo..."
  self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ].
 
  self successful ifFalse:
  [^self primitiveFail].
 
  arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name.
  arrayNilOrSymbol ifNil:
  [self pop: 3 thenPush: objectMemory nilObject.
  ^self].
  arrayNilOrSymbol isArray ifFalse:
  ["arrayNilOrSymbol ~~ #primFailed ifTrue:
  [self halt]. "
+ self transcript show: name , ' NOT FOUND'.
- Transcript show: name , ' NOT FOUND'.
  ^self primitiveFail].
 
  result := PharoVM
  ifTrue:
  [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5)
  posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ]
  ifFalse:
  [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ].
  self pop: 3 thenPush: result!