Vm-dev June 2018

vm-dev@lists.squeakfoundation.org

21 participants
83 discussions

Are EventTypeMenu events still in use?
by Cyril Ferlicot D 12 Jun '18

12 Jun '18

Hi, This weekend I cleaned some Pharo code referencing a class removed from Pharo since 2013 (HostSystemMenus). >From what I understood, there is a special event the VM can send only in OSX representing an EventTypeMenu event with a constant code of 4. For now I kept some guards in the code of the InputEventSensor class in case Pharo receive this kind of event, but I am not sure the VM still sent them. Does someone knows if the VM can still send EventTypeMenu events? -- Cyril Ferlicot https://ferlicot.fr

2 1

VM Maker: VMMaker.oscog-eem.2416.mcz
by commits＠source.squeak.org 12 Jun '18

12 Jun '18

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2416.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2416 Author: eem Time: 11 June 2018, 3:06:29.068448 pm UUID: 88c7bf4a-5169-4686-bc31-3e8e99bcfc17 Ancestors: VMMaker.oscog-eem.2415 More initializationOptions clean-ups. =============== Diff against VMMaker.oscog-eem.2415 =============== Item was changed: ----- Method: CogObjectRepresentationForSpur class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCodeGen "Deal wuth the fact that the number of trampolines depends on IMMUTABILITY and that IMMUTABILITY can be defined at compile time. Yes, this is a mess." | current values | - self assert: (CogObjectRepresentationForSpur allSubclasses allSatisfy: - [:sc| - CogObjectRepresentationForSpur initializationOptions == sc initializationOptions]). current := InitializationOptions at: #IMMUTABILITY ifAbsent: nil. values := #(true false) collect: [:bool| InitializationOptions at: #IMMUTABILITY put: bool. self cogitClass initializeNumTrampolines. (Cogit classPool at: #NumTrampolines) printString]. current ifNil: [InitializationOptions removeKey: #IMMUTABILITY] ifNotNil: [InitializationOptions at: #IMMUTABILITY put: current]. values first ~= values last ifTrue: [aCodeGen addConstantForBinding: #NumTrampolines -> ('(IMMUTABILITY ? ' , values first , ' : ' , values last , ')')]. aCodeGen var: #ceStoreTrampolines declareC: ('#if IMMUTABILITY\sqInt ceStoreTrampolines[', NumStoreTrampolines printString, '];\#endif') withCRs! Item was changed: ----- Method: CogX64Compiler class>>initialize (in category 'class initialization') ----- initialize "Initialize various x64 instruction-related constants. [1] IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M" "CogX64Compiler initialize" self ~~ CogX64Compiler ifTrue: [^self]. + (InitializationOptions ifNil: [Dictionary new]) - InitializationOptions at: #ABI ifPresent: [:abi| SysV := abi asUppercase ~= #WIN64 and: [abi asUppercase ~= #'_WIN64']] ifAbsent: [SysV := true]. "Default ABI; set to true for SysV, false for WIN64/_WIN64" RAX := 0. RCX := 1. "Were they completely mad or simply sadistic?" RDX := 2. RBX := 3. RSP := 4. RBP := 5. RSI := 6. RDI := 7. R8 := 8. R9 := 9. R10 := 10. R11 := 11. R12 := 12. R13 := 13. R14 := 14. R15 := 15. XMM0L := 0. XMM1L := 1. XMM2L := 2. XMM3L := 3. XMM4L := 4. XMM5L := 5. XMM6L := 6. XMM7L := 7. XMM8L := 8. XMM9L := 9. XMM10L := 10. XMM11L := 11. XMM12L := 12. XMM13L := 13. XMM14L := 14. XMM15L := 15. "Mod R/M Mod fields. See [1] Sec 2.4, 2.5 & 2.6 & Table 2-2" ModRegInd := 0. ModRegIndSIB := 4. ModRegIndDisp32 := 5. ModRegRegDisp8 := 1. ModRegRegDisp32 := 2. ModReg := 3. "SIB Scaled Index modes. See [1] Sec 2.4, 2.5 & 2.6 & Table 2-3" SIB1 := 0. SIB2 := 1. SIB4 := 2. SIB8 := 3. "Specific instructions" self initializeSpecificOpcodes: #(CDQ IDIVR IMULRR CPUID LFENCE MFENCE SFENCE LOCK CMPXCHGAwR CMPXCHGMwrR XCHGAwR XCHGMwrR XCHGRR CLD REP MOVSB MOVSQ) in: thisContext method!

1 0

VM Maker: VMMaker.oscog-eem.2415.mcz
by commits＠source.squeak.org 11 Jun '18

11 Jun '18

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2415.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2415 Author: eem Time: 11 June 2018, 1:50:21.895989 pm UUID: 19cb3316-13c5-470d-8ceb-8744851e6fff Ancestors: VMMaker.oscog-eem.2414 Having a VMMaker-specific decompiler test and decompiler test failure collecrtor helps checking for compiler issues (e.g. just discovered one of my images has a mis-compiled SpurCompactor hierarchy). =============== Diff against VMMaker.oscog-eem.2414 =============== Item was added: + DecompilerTestFailuresCollector subclass: #VMMakerDecompilerTestFailuresCollector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Tests'! Item was added: + ----- Method: VMMakerDecompilerTestFailuresCollector>>classNames (in category 'utilities') ----- + classNames + "A list of the classes in most of the base packages; excluding EToys arbitrarily for now" + ^(PackageInfo named: 'VMMaker') classes collect: [:ea| ea name]! Item was added: + DecompilerTests subclass: #VMMakerDecompilerTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Tests'! Item was added: + ----- Method: VMMakerDecompilerTests>>classNames (in category 'utilities') ----- + classNames + "A list of the classes in most of the base packages; excluding EToys arbitrarily for now" + ^(PackageInfo named: 'VMMaker') classes collect: [:ea| ea name]! Item was added: + ----- Method: VMMakerDecompilerTests>>testDecompilationOfClasses (in category 'tests') ----- + testDecompilationOfClasses + self decompileClassesSelect: [:cn| true]!

1 0

VM Maker: VMMaker.oscog-eem.2414.mcz
by commits＠source.squeak.org 11 Jun '18

11 Jun '18

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2414.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2414 Author: eem Time: 11 June 2018, 12:44:30.357346 pm UUID: 6166323c-d4c3-4a45-b794-cccb2595acb7 Ancestors: VMMaker.oscog-cb.2413 Update some class comments. =============== Diff against VMMaker.oscog-cb.2413 =============== Item was changed: CogClass subclass: #SpurCompactor + instanceVariableNames: 'coInterpreter manager scavenger' - instanceVariableNames: 'manager scavenger coInterpreter' classVariableNames: '' poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMSpurObjectRepresentationConstants' category: 'VMMaker-SpurMemoryManager'! !SpurCompactor commentStamp: 'cb 4/27/2018 09:38' prior: 0! Abstract common superclass of all compactors to define apis and simulation variables. The full GC in Spur is split in two, the marking phase and the compactor phase. The subclasses of SpurCompactor are implementations of the second phase, so they are called once the marking phase is finished. SpurCompactor is reponsible for: - freeing unmarked objects - compacting the live old space objects (though each subclass define what it does, some spurCompactor may not compact) - unmarking all objects remaining live - updating oops directly referred by the VM when they are moved (remapObj:/shouldRemapObj: thingy) The main apis are the following: - biasForGC/biasForSnapshot: tells the compactor if the GC is performed for snapshots or not, in general we want to compact more aggressively for snapshots to avoid saving large files with many unused space. - compact: main API, should free the unmarked object, unmark the objects remaining live and potentially compact the heap - remapObj:/shouldRemapObj: => Not really sure what this does, it seems it has to do with updating oops directly referred by the VM when they are moved. - postSwizzleAction: if you want to do something at start-up after swizzle phase (typically useful if your compaction algo uses segInfos) Instance Variables coInterpreter: <StackInterpreter> scavenger: <SpurGenerationScavenger> manager: <SpurMemoryManager>! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: SpurCompactor subclass: #SpurPlanningCompactor + instanceVariableNames: 'anomaly biasForGC firstFieldOfRememberedSet firstFreeObject firstMobileObject lastMobileObject mobileStart objectAfterLastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace' - instanceVariableNames: 'biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace firstFieldOfRememberedSet anomaly objectAfterLastMobileObject' classVariableNames: '' poolDictionaries: 'VMBytecodeConstants' category: 'VMMaker-SpurMemoryManager'! + !SpurPlanningCompactor commentStamp: 'eem 6/11/2018 12:43' prior: 0! + SpurPlanningCompactor implements the classic planning compaction algorithm for Spur. It uses the fact that there is room for a forwarding pointer in all objects to store the eventual position of an object in the first field. It therefore first locates a large free chunk, or eden or a memory segment, to use as the savedFirstFieldsSpace, which it uses to store the first fields of objects that will be compacted. It then makes at least three passes through the heap. - !SpurPlanningCompactor commentStamp: 'eem 12/23/2016 17:50' prior: 0! - SpurPlanningCompactor implements the classic planning compaction algorithm for Spur. It makes at least three passes through the heap. The first pass plans where live movable objects will go, copying their forwarding field to the next slot in savedFirstFieldsSpace, and setting their forwarding pointer to point to their eventual location. The second pass updates all pointers in live pointer objects to point to objects' final destinations. The third pass moves objects to their final positions, unmarking objects as it does so. If the forwarding fields of live objects in the to-be-moved portion of the entire heap won't fit in savedFirstFieldsSpace, then additional passes are made until the entire heap has been compacted. + The first pass plans where live movable objects will go, copying their first field to the next slot in savedFirstFieldsSpace, and setting their forwarding pointer to point to their eventual location (see planCompactSavingForwarders). The second pass updates all pointers in live pointer objects to point to objects' final destinations, including the fields in savedFirstFieldsSpace (see updatePointers and updatePointersInMobileObjects). The third pass moves objects to their final positions, unmarking objects, and restoring saved first fields as it does so (see copyAndUnmark: and copyAndUnmarkMobileObjects). If the forwarding fields of live objects in the to-be-moved portion of the entire heap won't fit in savedFirstFieldsSpace, then additional passes can be made until the entire heap has been compacted. When snapshotting multiple passes are made, but when doing a normal GC only one pass is made. + + Each pass uses a three finger algorithm, a simple extension of the classic two finger algorithm with an extra finger used to identify the lowest pinned object between the to and from fingers. Objects are moved down, starting at the first free object or chunk, provided that they fit below the lowest pinned object above the to finger. When an object won't fit the to finger is moved above the pinned object and the third finger is reset to the next pinned object below the from finger, if any. + Instance Variables + anomaly <Oop> + biasForGC <Boolean> + firstFieldOfRememberedSet <Oop> + firstFreeObject <Oop> + firstMobileObject <Oop> + lastMobileObject <Oop> + mobileStart <Integer address> + objectAfterLastMobileObject <Oop|nil> - biasForGC <Boolean> - coInterpreter: <StackInterpreter> - firstFieldOfRememberedSet <Oop> - firstFreeObject <Oop> - firstMobileObject <Oop> - lastMobileObject <Oop> - manager: <SpurMemoryManager> savedFirstFieldsSpace <SpurContiguousObjStack> savedFirstFieldsSpaceWasAllocated <Boolean> - scavenger: <SpurGenerationScavenger> + anomaly + - if any bogus object is detected by asserts, etc, it is stored in anomaly + biasForGC - true if compacting for GC, in which case do only one pass, or false if compacting for snapshot, in which case do as many passes as necessary to compact the entire heap. firstFieldOfRememberedSet - the saved first field of the rememberedSet. The rememberedSet must be relocated specially because it is not a pointer object. And hence the first field needs to be extracted for proper relocation. firstFreeObject - the first free object in a compaction pass. firstMobileObject - the first mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded. lastMobileObject - the last mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded. + mobileStart + - the address of the first byte in firstFreeObject + + objectAfterLastMobileObject + - the object following the last object that can be moved, used when more than one pass is needed. + savedFirstFieldsSpace - the space holding the saved first fields, each overwritten by a forwarding pointer, for the objects from firstMobileObject through to lastMobileObject. savedFirstFieldsSpaceWasAllocated - if true, the memory for savedFirstFieldsSpace was obtained via a call of sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto:!

1 0

VM Maker: VMMaker.oscog-cb.2413.mcz
by commits＠source.squeak.org 11 Jun '18

11 Jun '18

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2413.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.2413 Author: cb Time: 11 June 2018, 10:08:32.760001 am UUID: c1f5cce4-832d-4512-bf43-1d69f1a3abc2 Ancestors: VMMaker.oscog-cb.2412 Fixed a bug when new segment was allocated in C sometimes the swizzle field used by SelectiveCompactor got corrupted. Changed assertions here and there. Now SelectiveCompactor starts to resist serious stress benchmarks... I need to try again the 20+Gb bench and it's good to go. =============== Diff against VMMaker.oscog-cb.2412 =============== Item was changed: ----- Method: Spur32BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders"]]). - or: [fieldIndex = 0 "forwarders and free objs" - or: [fieldIndex = 1 and: [self isFreeObject: objOop]]]]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was changed: ----- Method: Spur32BitMMLESimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders"]]). - or: [fieldIndex = 0 "forwarders and free objs" - or: [fieldIndex = 1 and: [self isFreeObject: objOop]]]]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was changed: ----- Method: Spur64BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders"]]). - or: [fieldIndex = 0 "forwarders and free objs"]]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was changed: ----- Method: Spur64BitMMLESimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders"]]). - or: [fieldIndex = 0 "forwarders and free objs"]]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was changed: ----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') ----- addToFreeList: freeChunk bytes: chunkBytes "Add freeChunk to the relevant freeList. For the benefit of sortedFreeObject:, if freeChunk is large, answer the treeNode it is added to, if it is added to the next list of a freeTreeNode, otherwise answer 0." | index | "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk." self assert: (self isFreeObject: freeChunk). self assert: chunkBytes = (self bytesInObject: freeChunk). + "Too slow to be enabled byt default but useful to debug Selective... + self deny: (compactor isSegmentBeingCompacted: (segmentManager segmentContainingObj: freeChunk))." index := chunkBytes / self allocationUnit. index < self numFreeLists ifTrue: [self setNextFreeChunkOf: freeChunk withValue: (freeLists at: index) chunkBytes: chunkBytes. (self bytesBigEnoughForPrevPointer: chunkBytes) ifTrue: [self storePointer: self freeChunkPrevIndex ofFreeChunk: freeChunk withValue: 0]. freeLists at: index put: freeChunk. freeListsMask := freeListsMask bitOr: 1 << index. ^0]. ^self addToFreeTree: freeChunk bytes: chunkBytes! Item was added: + ----- Method: SpurMemoryManager>>assertFreeChunkPrevHeadZero (in category 'free space') ----- + assertFreeChunkPrevHeadZero + |min| + self wordSize = 8 ifTrue: [min := 3] ifFalse: [min := 2]. + min to: self numFreeLists - 1 do: + [:i| + (freeLists at: i) ~= 0 ifTrue: + [self assert: (self bytesBigEnoughForPrevPointer: (freeLists at: i)). + self assert: (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: (freeLists at: i)) = 0]]. + "Large chunks" + self freeTreeNodesDo: [:freeNode | + self assert: (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: freeNode) = 0. + freeNode]. + ^ true! Item was changed: ----- Method: SpurMemoryManager>>assertInnerValidFreeObject: (in category 'free space') ----- assertInnerValidFreeObject: objOop + <inline: #never> "we don't want to inline so we can nest that in an assertion with the return true so the production VM does not generate any code here, while in simulation, the code breaks on the assertion we want to." - <inline: #never> "we don't want to inline so we can nest that in an assertion with the return true so the production VM does not generate any code here, whil ein simulation, the code breaks on the assertion we want to." | chunk index | - "duplicated assertions from isValidFreeObject: because I need to know what is wrong not only that it is not valid (I got bored of stepping inside isValidFreeObject:...)" self assert: (self oop: (self addressAfter: objOop) isLessThanOrEqualTo: endOfMemory). chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop. self assert: (chunk = 0 or: [self isFreeOop: chunk]). (self bytesBigEnoughForPrevPointer: (self bytesInObject: objOop)) ifTrue: ["double linkedlist assertions" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop. chunk = 0 ifFalse: [self assert: (self isFreeOop: chunk). self assert: objOop = (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk)]. chunk := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: objOop. index := (self bytesInObject: objOop) / self allocationUnit. + (index < self numFreeLists and: [1 << index <= freeListsMask]) + ifTrue: + [(freeLists at: index) = objOop ifTrue: [self assert: chunk = 0]] + ifFalse: + [self freeTreeNodesDo: [:freeNode | + freeNode = objOop ifTrue: [self assert: chunk = 0]. freeNode]]. - (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue: - [(freeLists at: index) = objOop ifTrue: [self assert: chunk = 0]]. chunk = 0 ifFalse: [self assert: (self isFreeOop: chunk). self assert: objOop = (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)]]. (self isLargeFreeObject: objOop) ifTrue: ["Tree assertions" chunk := self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop. self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). chunk := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop. self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). chunk := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop. self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]])]. ^ true! Item was changed: ----- Method: SpurMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') ----- fetchPointer: fieldIndex ofFreeChunk: objOop - self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) - or: [fieldIndex = 0 "forwarders and free objs" - or: [fieldIndex = 1 and: [self wordSize = 4]]]]). ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! 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: ' bytes '; printNum: numBytes; print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk). + (self bytesBigEnoughForPrevPointer: numBytes) ifTrue: + [coInterpreter + print: ' prev '; printHexPtrnp: (self fetchPointer: self freeChunkPrevIndex + 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>>storePointer:ofFreeChunk:withValue: (in category 'heap management') ----- storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer self assert: (self isFreeObject: objOop). + self assert: (valuePointer = 0 or: [self isFreeObject: valuePointer]). - self assert: (valuePointer = 0 or: [self isFreeObject: valuePointer]). - self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) - or: [fieldIndex = 0 "forwarders and free objs" - or: [fieldIndex = 1 and: [self wordSize = 4]]]]). - ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was changed: ----- Method: SpurMemoryManager>>updateFreeLists (in category 'initialization') ----- updateFreeLists "Snapshot did not guarantee the state of the freelist prevLink, so we need to update it. Effectively transforms the freechunk single linked list in double linked list." |min| "Small chunks" "Skip in 64 bits size 1 which is single linked list - pathological case" + self wordSize = 8 ifTrue: [min := 3] ifFalse: [min := 2]. - self wordSize = 8 ifTrue: [min := 2] ifFalse: [min := 1]. min to: self numFreeLists - 1 do: [:i| self updateListStartingAt: (freeLists at: i)]. "Large chunks" self freeTreeNodesDo: [:freeNode | self updateListStartingAt: freeNode. freeNode]! Item was changed: ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') ----- addSegmentOfSize: ammount <returnTypeC: #'SpurSegmentInfo *'> <inline: false> | allocatedSize | <var: #newSeg type: #'SpurSegmentInfo *'> <var: #segAddress type: #'void *'> <var: #allocatedSize type: #'usqInt'> self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap" (manager "sent to the manager so that the simulator can increase memory to simulate a new segment" sqAllocateMemorySegmentOfSize: ammount Above: (self firstGapOfSizeAtLeast: ammount) AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize] inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil: [:segAddress| | newSegIndex newSeg | newSegIndex := self insertSegmentFor: segAddress asUnsignedIntegerPtr. "Simulation insertion code duplicates entries if newSegIndex ~= numSegments - 1" self cCode: '' inSmalltalk: [segments at: newSegIndex put: SpurSegmentInfo new]. newSeg := self addressOf: (segments at: newSegIndex). newSeg segStart: segAddress asUnsignedIntegerPtr; + segSize: allocatedSize; + swizzle: 0. "Required in the C version only" - segSize: allocatedSize. self assert: self segmentOverlap not. "self printSegmentAddresses." self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg. self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse: [self addressOf: (segments at: newSegIndex + 1)]). totalHeapSizeIncludingBridges := totalHeapSizeIncludingBridges + allocatedSize. "test isInMemory:" 0 to: numSegments - 1 do: [:i| self assert: (self isInSegments: (segments at: i) segStart). self assert: (self isInSegments: (segments at: i) segLimit - manager wordSize). self assert: ((self isInSegments: (segments at: i) segLimit) not or: [i < (numSegments - 1) and: [(segments at: i) segLimit = (segments at: i + 1) segStart]]). self assert: ((self isInSegments: (segments at: i) segStart - manager wordSize) not or: [i > 0 and: [(segments at: i - 1) segLimit = (segments at: i) segStart]])]. ^newSeg]. ^nil! Item was changed: ----- Method: SpurSelectiveCompactor>>freeSegment: (in category 'segment access') ----- freeSegment: segInfo <var: 'segInfo' type: #'SpurSegmentInfo *'> + "self unmarkSegmentAsBeingCompacted: segInfo. 'For assertion in free chunk management'." manager addFreeChunkWithBytes: segInfo segSize - manager bridgeSize at: segInfo segStart.! Item was added: + ----- Method: SpurSelectiveCompactor>>unmarkSegmentAsBeingCompacted: (in category 'segment access') ----- + unmarkSegmentAsBeingCompacted: segInfo + <inline: true> "So it is not generated if unused" + <var: 'segInfo' type: #'SpurSegmentInfo *'> + "Swizzle is abused bit 16 isBeingCompacted bits 0-15 occupation" + segInfo swizzle: (segInfo swizzle bitAnd: 16rFFFF)! Item was changed: ----- Method: SpurSelectiveCompactorSimulator>>checkSegmentToFillLooksAllRight (in category 'debugging') ----- checkSegmentToFillLooksAllRight "Check only 1 free object at the end or none. Check segment is iterable until bridge" | currentEntity bridge | self talk: 'Checking segment to fill iterable/last is free ' , (manager segmentManager indexOfSegment: segmentToFill) printString. bridge := manager segmentManager bridgeFor: segmentToFill. currentEntity := manager objectStartingAt: segmentToFill segStart. [self oop: currentEntity isLessThan: bridge] whileTrue: [(manager isFreeObject: currentEntity) ifTrue: "should be last entity" [self assert: (manager objectAfter: currentEntity limit: manager endOfMemory) = bridge. + manager assertValidFreeObject: currentEntity]. - self assertValidFreeObject: currentEntity]. currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory]. "End of iteration should end on bridge" self assert: currentEntity = bridge. self talkNoCr: ' OK'.!

1 0

VM Maker: VMMaker.oscog-cb.2410.mcz
by commits＠source.squeak.org 08 Jun '18

08 Jun '18

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2410.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.2410 Author: cb Time: 8 June 2018, 10:40:45.005502 am UUID: c739c9d4-b3eb-468f-9534-78221de8a653 Ancestors: VMMaker.oscog-eem.2409 - Added assertions for free chunks like crazy. - Fixed the double linked list scheme (now everything resists the leak checker in stress GC benchs in 64 bits, previously it worked only in 32 bits) =============== Diff against VMMaker.oscog-eem.2409 =============== Item was changed: ----- Method: Spur32BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders and free objs" + or: [fieldIndex = 1]]]). - or: [fieldIndex = 0 "forwarders and free objs"]]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was changed: ----- Method: Spur32BitMMLESimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders and free objs" + or: [fieldIndex = 1]]]). - or: [fieldIndex = 0 "forwarders and free objs"]]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if available, otherwise answer nil. Break up a larger chunk if one of the exact size does not exist. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." <var: #chunkBytes type: #usqInt> | initialIndex chunk index nodeBytes parent child | "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" initialIndex := chunkBytes / self allocationUnit. (initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue: [(freeListsMask anyMask: 1 << initialIndex) ifTrue: [(chunk := freeLists at: initialIndex) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). + self assertValidFreeObject: chunk. + self unlinkFreeChunk: chunk atIndex: initialIndex chunkBytes: chunkBytes. + ^ chunk]. - self assert: (self isValidFreeObject: chunk). - ^self unlinkFreeChunk: chunk atIndex: initialIndex chunkBytes: chunkBytes]. freeListsMask := freeListsMask - (1 << initialIndex)]. "first search for free chunks of a multiple of chunkBytes in size" index := initialIndex. [(index := index + index) < self numFreeLists and: [1 << index <= freeListsMask]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). + self assertValidFreeObject: chunk. + self unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: true. - self assert: (self isValidFreeObject: chunk). - self unlinkFreeChunk: chunk atIndex: index chunkBytes: chunkBytes. self assert: (self bytesInObject: chunk) = (index * self allocationUnit). self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]. "now get desperate and use the first that'll fit. Note that because the minimum free size is 16 bytes (2 * allocationUnit), to leave room for the forwarding pointer/next free link, we can only break chunks that are at least 16 bytes larger, hence start at initialIndex + 2." index := initialIndex + 1. [(index := index + 1) < self numFreeLists and: [1 << index <= freeListsMask]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). + self assertValidFreeObject: chunk. + self unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: true. - self assert: (self isValidFreeObject: chunk). - self unlinkFreeChunk: chunk atIndex: index chunkBytes: chunkBytes. self assert: (self bytesInObject: chunk) = (index * self allocationUnit). self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks. When the search ends parent should hold the smallest chunk at least as large as chunkBytes, or 0 if none." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [| childBytes | + self assertValidFreeObject: child. - self assert: (self isValidFreeObject: child). childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: + [self assertValidFreeObject: chunk. - [self assert: (self isValidFreeObject: chunk). self setNextFreeChunkOf: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk) bytesBigEnoughForPrevPointer: true. ^self startOfObject: chunk]. nodeBytes := childBytes. parent := child. child := 0] "break out of loop to remove interior node" ifFalse: ["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to leave room for the forwarding pointer/next free link, we can only break chunks that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger." childBytes <= (chunkBytes + self allocationUnit) ifTrue: "node too small; walk down the larger size of the tree" [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] ifFalse: [parent := child. "parent will be smallest node >= chunkBytes + allocationUnit" nodeBytes := childBytes. child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]]. parent = 0 ifTrue: [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" ^nil]. "self printFreeChunk: parent" self assert: (nodeBytes = chunkBytes or: [nodeBytes >= (chunkBytes + (2 * self allocationUnit))]). self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self assert: (chunkBytes = nodeBytes or: [chunkBytes + self allocationUnit < nodeBytes]). self setNextFreeChunkOf: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk) bytesBigEnoughForPrevPointer: true. chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "no list; remove the interior node" chunk := parent. self unlinkSolitaryFreeTreeNode: chunk. "if there's space left over, add the fragment back." chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock "Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock, if available, otherwise answer nil. Break up a larger chunk if one of the exact size cannot be found. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." <var: #chunkBytes type: #usqInt> | initialIndex node next prev index child childBytes acceptedChunk acceptedNode | <inline: true> "must inline for acceptanceBlock" "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" initialIndex := chunkBytes / self allocationUnit. (initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue: [(freeListsMask anyMask: 1 << initialIndex) ifTrue: [(node := freeLists at: initialIndex) = 0 ifTrue: [freeListsMask := freeListsMask - (1 << initialIndex)] ifFalse: [prev := 0. [node ~= 0] whileTrue: [self assert: node = (self startOfObject: node). + self assertValidFreeObject: node. - self assert: (self isValidFreeObject: node). next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. (acceptanceBlock value: node) ifTrue: [prev = 0 + ifTrue: [self unlinkFreeChunk: node atIndex: initialIndex chunkBytes: chunkBytes] - ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes] ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes]. ^node]. prev := node. node := next]]]. "first search for free chunks of a multiple of chunkBytes in size" index := initialIndex. [(index := index + initialIndex) < self numFreeLists and: [1 << index <= freeListsMask]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(node := freeLists at: index) = 0 ifTrue: [freeListsMask := freeListsMask - (1 << index)] ifFalse: [prev := 0. [node ~= 0] whileTrue: [self assert: node = (self startOfObject: node). + self assertValidFreeObject: node. - self assert: (self isValidFreeObject: node). next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. (acceptanceBlock value: node) ifTrue: [prev = 0 + ifTrue: [self unlinkFreeChunk: node atIndex: index bytesBigEnoughForPrevPointer: true.] + ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: true.]. - ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes] - ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes]. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: node) + chunkBytes. ^node]. prev := node. node := next]]]]. "now get desperate and use the first that'll fit. Note that because the minimum free size is 16 bytes (2 * allocationUnit), to leave room for the forwarding pointer/next free link, we can only break chunks that are at least 16 bytes larger, hence start at initialIndex + 2." index := initialIndex + 1. [(index := index + 1) < self numFreeLists and: [1 << index <= freeListsMask]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(node := freeLists at: index) = 0 ifTrue: [freeListsMask := freeListsMask - (1 << index)] ifFalse: [prev := 0. [node ~= 0] whileTrue: [self assert: node = (self startOfObject: node). + self assertValidFreeObject: node. - self assert: (self isValidFreeObject: node). next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. (acceptanceBlock value: node) ifTrue: [prev = 0 + ifTrue: [self unlinkFreeChunk: node atIndex: index bytesBigEnoughForPrevPointer: true.] + ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: true.]. - ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes] - ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes]. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: node) + chunkBytes. ^node]. prev := node. node := next]]]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks. When the search ends parent should hold the smallest chunk at least as large as chunkBytes, or 0 if none. acceptedChunk and acceptedNode save us from having to back-up when the acceptanceBlock filters-out all nodes of the right size, but there are nodes of the wrong size it does accept." child := freeLists at: 0. node := acceptedChunk := acceptedNode := 0. [child ~= 0] whileTrue: + [ self assertValidFreeObject: child. - [self assert: (self isValidFreeObject: child). childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [node := child. [prev := node. node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. node ~= 0] whileTrue: [(acceptanceBlock value: node) ifTrue: + [self assertValidFreeObject: node. - [self assert: (self isValidFreeObject: node). self setNextFreeChunkOf: prev withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) bytesBigEnoughForPrevPointer: true. ^self startOfObject: node]]. (acceptanceBlock value: child) ifTrue: [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. next = 0 ifTrue: "no list; remove the interior node" [self unlinkSolitaryFreeTreeNode: child] ifFalse: "list; replace node with it" [self inFreeTreeReplace: child with: next]. ^self startOfObject: child]]. child ~= 0 ifTrue: ["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to leave room for the forwarding pointer/next free link, we can only break chunks that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger." childBytes <= (chunkBytes + self allocationUnit) ifTrue: "node too small; walk down the larger size of the tree" [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] ifFalse: [self flag: 'we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down'. node := child. child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node. acceptedNode = 0 ifTrue: [acceptedChunk := node. "first search the list." [acceptedChunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk. (acceptedChunk ~= 0 and: [acceptanceBlock value: acceptedChunk]) ifTrue: [acceptedNode := node]. acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue. "nothing on the list; will the node do? This prefers acceptable nodes higher up the tree over acceptable list elements further down, but we haven't got all day..." (acceptedNode = 0 and: [acceptanceBlock value: node]) ifTrue: [acceptedNode := node. child := 0 "break out of loop now we have an acceptedNode"]]]]]. acceptedNode ~= 0 ifTrue: [acceptedChunk ~= 0 ifTrue: [self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit). [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode. next ~= acceptedChunk] whileTrue: [acceptedNode := next]. self setNextFreeChunkOf: acceptedNode withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk) bytesBigEnoughForPrevPointer: true. self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes at: (self startOfObject: acceptedChunk) + chunkBytes. ^self startOfObject: acceptedChunk]. next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode. next = 0 ifTrue: "no list; remove the interior node" [self unlinkSolitaryFreeTreeNode: acceptedNode] ifFalse: "list; replace node with it" [self inFreeTreeReplace: acceptedNode with: next]. self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit). self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes at: (self startOfObject: acceptedNode) + chunkBytes. ^self startOfObject: acceptedNode]. totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" ^nil! Item was removed: - ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes: (in category 'free space') ----- - allocateOldSpaceChunkOfExactlyBytes: chunkBytes - "Answer a chunk of oldSpace from the free lists, if one of this size - is available, otherwise answer nil. N.B. the chunk is simply a pointer, - it has no valid header. The caller *must* fill in the header correctly." - <var: #chunkBytes type: #usqInt> - | index node child | - "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" - - index := chunkBytes / self allocationUnit. - index < self numFreeLists ifTrue: - [(freeListsMask anyMask: 1 << index) ifTrue: - [(node := freeLists at: index) ~= 0 ifTrue: - [self assert: node = (self startOfObject: node). - self assert: (self isValidFreeObject: node). - totalFreeOldSpace := totalFreeOldSpace - chunkBytes. - ^self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes]. - freeListsMask := freeListsMask - (1 << index)]. - ^nil]. - - "Large chunk. Search the large chunk list. - Large chunk list organized as a tree, each node of which is a list of - chunks of the same size. Beneath the node are smaller and larger - blocks. When the search ends parent should hold the first chunk of - the same size as chunkBytes, or 0 if none." - child := freeLists at: 0. - [child ~= 0] whileTrue: - [| childBytes | - self assert: (self isValidFreeObject: child). - childBytes := self bytesInObject: child. - childBytes = chunkBytes - ifTrue: "size match; try to remove from list at node." - [node := self fetchPointer: self freeChunkNextIndex - ofFreeChunk: child. - node ~= 0 ifTrue: - [self assert: (self isValidFreeObject: node). - self - setNextFreeChunkOf: child - withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) - bytesBigEnoughForPrevPointer: true. - totalFreeOldSpace := totalFreeOldSpace - chunkBytes. - ^self startOfObject: node]. - "nothing acceptable on node's list; answer the node." - self unlinkSolitaryFreeTreeNode: child. - totalFreeOldSpace := totalFreeOldSpace - chunkBytes. - ^self startOfObject: child] - ifFalse: - [child := self fetchPointer: (childBytes < chunkBytes - ifTrue: [self freeChunkLargerIndex] - ifFalse: [self freeChunkSmallerIndex]) - ofFreeChunk: child]]. - ^nil! Item was added: + ----- Method: SpurMemoryManager>>assertInnerValidFreeObject: (in category 'free space') ----- + assertInnerValidFreeObject: objOop + <inline: #never> "we don't want to inline so we can nest that in an assertion with the return true so the production VM does not generate any code here, whil ein simulation, the code breaks on the assertion we want to." + | chunk index | + "duplicated assertions from isValidFreeObject: because I need to know what is wrong not only that it is not valid (I got bored of stepping inside isValidFreeObject:...)" + self assert: (self oop: (self addressAfter: objOop) isLessThanOrEqualTo: endOfMemory). + chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop. + self assert: (chunk = 0 or: [self isFreeOop: chunk]). + (self bytesBigEnoughForPrevPointer: (self bytesInObject: objOop)) ifTrue: + ["double linkedlist assertions" + chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop. + chunk = 0 ifFalse: + [self assert: (self isFreeOop: chunk). + self assert: objOop = (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk)]. + chunk := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: objOop. + index := (self bytesInObject: objOop) / self allocationUnit. + (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue: + [(freeLists at: index) = objOop ifTrue: [self assert: chunk = 0]]. + chunk = 0 ifFalse: + [self assert: (self isFreeOop: chunk). + self assert: objOop = (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)]]. + (self isLargeFreeObject: objOop) ifTrue: + ["Tree assertions" + chunk := self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop. + self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). + chunk := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop. + self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). + chunk := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop. + self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]])]. + ^ true! Item was changed: ----- Method: SpurMemoryManager>>assertValidFreeObject: (in category 'free space') ----- assertValidFreeObject: objOop + <inline: true> + "assertInnerValidFreeObject: is never inlined and always returns true. + For the production VM, this is entirely removed. + For the other VMs and in simulation, the code breaks at the first warning/assertion failure" + self assert: (self assertInnerValidFreeObject: objOop)! - <doNotGenerate> "If you want to generate this you want to use 'self assert: (self isValidFreeObject: objOop)' instead not to generate code in assertion-free VMs" - | chunk | - "duplicated assertions from isValidFreeObject: because I need to know what is wrong not only that it is not valid (I got bored of stepping inside isValidFreeObject:...)" - self assert: (self oop: (self addressAfter: objOop) isLessThanOrEqualTo: endOfMemory). - chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop. - self assert: (chunk = 0 or: [self isFreeOop: chunk]). - (self bytesBigEnoughForPrevPointer: (self bytesInObject: objOop)) ifTrue: - ["double linkedlist assertions" - chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop. - chunk = 0 ifFalse: - [self assert: (self isFreeOop: chunk). - self assert: objOop = (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk)]. - chunk := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: objOop. - chunk = 0 ifFalse: - [self assert: (self isFreeOop: chunk). - self assert: objOop = (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)].]. - (self isLargeFreeObject: objOop) ifTrue: - ["Tree assertions" - chunk := self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop. - self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). - chunk := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop. - self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). - chunk := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop. - self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). ]! Item was changed: ----- Method: SpurMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') ----- fetchPointer: fieldIndex ofFreeChunk: objOop + self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders and free objs" + or: [fieldIndex = 1 and: [self wordSize = 4]]]]). ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was changed: ----- Method: SpurMemoryManager>>findLargestFreeChunk (in category 'free space') ----- findLargestFreeChunk "Answer, but do not remove, the largest free chunk in the free lists." | treeNode childNode | treeNode := freeLists at: 0. treeNode = 0 ifTrue: [^nil]. + [self assertValidFreeObject: treeNode. - [self assert: (self isValidFreeObject: treeNode). self assert: (self bytesInObject: treeNode) >= (self numFreeLists * self allocationUnit). childNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode. childNode ~= 0] whileTrue: [treeNode := childNode]. ^treeNode! Item was removed: - ----- Method: SpurMemoryManager>>isValidFreeObject: (in category 'free space') ----- - isValidFreeObject: objOop - | chunk | - ^(self addressCouldBeOldObj: objOop) - and: [(self isFreeObject: objOop) - and: [(self oop: (self addressAfter: objOop) isLessThanOrEqualTo: endOfMemory) - and: [((chunk := (self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop)) = 0 - or: [self isFreeOop: chunk]) - and: [ - (self bytesBigEnoughForPrevPointer: (self bytesInObject: objOop)) not - or: [((chunk := (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: objOop)) = 0 - or: [self isFreeOop: chunk]) - and: [(self isLargeFreeObject: objOop) not - or: [((chunk := (self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop)) = 0 - or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]) - and: [((chunk := (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop)) = 0 - or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]) - and: [(chunk := (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop)) = 0 - or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]]]]]]]]]]! Item was changed: ----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') ----- storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer self assert: (self isFreeObject: objOop). self assert: (valuePointer = 0 or: [self isFreeObject: valuePointer]). + self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders and free objs"] + or: [fieldIndex = 1 and: [self wordSize = 4]]]). + - ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was changed: ----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') ----- totalFreeListBytes "This method both computes the actual number of free bytes by traversing all free objects on the free lists/tree, and checks that the tree is valid. It is used mainly by checkFreeSpace." | totalFreeBytes bytesInChunk listNode nextNode | totalFreeBytes := 0. 1 to: self numFreeLists - 1 do: [:i| bytesInChunk := i * self allocationUnit. listNode := freeLists at: i. [listNode ~= 0] whileTrue: [totalFreeBytes := totalFreeBytes + bytesInChunk. + self assertValidFreeObject: listNode. - self - cCode: [self assert: (self isValidFreeObject: listNode)] - inSmalltalk: [self assertValidFreeObject: listNode]. self assert: bytesInChunk = (self bytesInObject: listNode). nextNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode. self assert: nextNode ~= listNode. listNode := nextNode]]. self freeTreeNodesDo: [:treeNode| bytesInChunk := self bytesInObject: treeNode. self assert: bytesInChunk / self allocationUnit >= self numFreeLists. listNode := treeNode. [listNode ~= 0] whileTrue: ["self printFreeChunk: listNode" + self assertValidFreeObject: listNode. - self assert: (self isValidFreeObject: listNode). self assert: (listNode = treeNode or: [(self fetchPointer: self freeChunkParentIndex ofFreeChunk: listNode) = 0]). totalFreeBytes := totalFreeBytes + bytesInChunk. self assert: bytesInChunk = (self bytesInObject: listNode). nextNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode. self assert: nextNode ~= listNode. listNode := nextNode]. treeNode]. ^totalFreeBytes! Item was added: + ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex:bytesBigEnoughForPrevPointer: (in category 'free space') ----- + unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: bytesBigEnoughForPrevPointer + "Unlink and answer a small chunk from one of the fixed size freeLists" + <inline: true> "inlining is important because bytesBigEnoughForPrevPointer is often true" + |next| + self assert: ((self bytesInObject: chunk) = (index * self allocationUnit) + and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit" + and: [(self startOfObject: chunk) = chunk]]). + self assert: (self bytesBigEnoughForPrevPointer:(self bytesInObject: chunk)) = bytesBigEnoughForPrevPointer. + freeLists + at: index + put: (next := self + fetchPointer: self freeChunkNextIndex + ofFreeChunk: chunk). + (bytesBigEnoughForPrevPointer and: [next ~= 0]) ifTrue: + [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: 0]. + ^chunk! Item was changed: ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex:chunkBytes: (in category 'free space') ----- unlinkFreeChunk: chunk atIndex: index chunkBytes: chunkBytes + ^self + unlinkFreeChunk: chunk + atIndex: index + bytesBigEnoughForPrevPointer: (self bytesBigEnoughForPrevPointer: chunkBytes) ! - "Unlink and answer a small chunk from one of the fixed size freeLists" - <inline: true> - |next| - self assert: ((self bytesInObject: chunk) = (index * self allocationUnit) - and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit" - and: [(self startOfObject: chunk) = chunk]]). - freeLists - at: index - put: (next := self - fetchPointer: self freeChunkNextIndex - ofFreeChunk: chunk). - ((self bytesBigEnoughForPrevPointer: chunkBytes) and: [next ~= 0]) ifTrue: - [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: 0]. - ^chunk! Item was changed: ----- Method: SpurMemoryManager>>unlinkFreeChunk:chunkBytes: (in category 'free space') ----- unlinkFreeChunk: freeChunk chunkBytes: chunkBytes "Unlink a free object from the free lists. Do not alter totalFreeOldSpace. Used for coalescing." | index node next prev | index := chunkBytes / self allocationUnit. "Pathological 64 bits case - size 1 - single linked list" - (self bytesBigEnoughForPrevPointer: chunkBytes) ifFalse: [node := freeLists at: index. prev := 0. [node ~= 0] whileTrue: [self assert: node = (self startOfObject: node). + self assertValidFreeObject: node. - self assert: (self isValidFreeObject: node). next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. node = freeChunk ifTrue: [prev = 0 + ifTrue: [self unlinkFreeChunk: freeChunk atIndex: index bytesBigEnoughForPrevPointer: false] + ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: false]. - ifTrue: [self unlinkFreeChunk: freeChunk atIndex: index chunkBytes: chunkBytes] - ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes]. ^self]. prev := node. node := next]. self error: 'freeChunk not found in free list of size 1']. prev := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: freeChunk. "Has prev element: update double linked list" prev ~= 0 ifTrue: [self setNextFreeChunkOf: prev withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk) chunkBytes: chunkBytes. ^self]. "Is the beginning of a list" "Small chunk" (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue: [ + ^self unlinkFreeChunk: freeChunk atIndex: index bytesBigEnoughForPrevPointer: true ]. - ^self unlinkFreeChunk: freeChunk atIndex: index chunkBytes: chunkBytes]. "Large chunk" next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk. next = 0 ifTrue: "no list; remove the interior node" [self unlinkSolitaryFreeTreeNode: freeChunk] ifFalse: "list; replace node with it" [self inFreeTreeReplace: freeChunk with: next] ! Item was changed: ----- Method: SpurSelectiveCompactorSimulator>>checkSegmentToFillLooksAllRight (in category 'debugging') ----- checkSegmentToFillLooksAllRight "Check only 1 free object at the end or none. Check segment is iterable until bridge" | currentEntity bridge | self talk: 'Checking segment to fill iterable/last is free ' , (manager segmentManager indexOfSegment: segmentToFill) printString. bridge := manager segmentManager bridgeFor: segmentToFill. currentEntity := manager objectStartingAt: segmentToFill segStart. [self oop: currentEntity isLessThan: bridge] whileTrue: [(manager isFreeObject: currentEntity) ifTrue: "should be last entity" [self assert: (manager objectAfter: currentEntity limit: manager endOfMemory) = bridge. + self assertValidFreeObject: currentEntity]. - self assert: (manager isValidFreeObject: currentEntity)]. currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory]. "End of iteration should end on bridge" self assert: currentEntity = bridge. self talkNoCr: ' OK'.!

2 1

VM Maker: VMMaker.oscog-cb.2412.mcz
by commits＠source.squeak.org 08 Jun '18

08 Jun '18

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2412.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.2412 Author: cb Time: 8 June 2018, 11:21:25.866032 am UUID: f19cf5db-fa17-4984-8f08-aac504dd5d67 Ancestors: VMMaker.oscog-cb.2411 - Fixed compilation errors and some warnings. =============== Diff against VMMaker.oscog-cb.2411 =============== Item was changed: ----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') ----- storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer self assert: (self isFreeObject: objOop). self assert: (valuePointer = 0 or: [self isFreeObject: valuePointer]). self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders and free objs" + or: [fieldIndex = 1 and: [self wordSize = 4]]]]). - or: [fieldIndex = 0 "forwarders and free objs"] - or: [fieldIndex = 1 and: [self wordSize = 4]]]). ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was changed: ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex:bytesBigEnoughForPrevPointer: (in category 'free space') ----- unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: bytesBigEnoughForPrevPointer "Unlink and answer a small chunk from one of the fixed size freeLists" <inline: true> "inlining is important because bytesBigEnoughForPrevPointer is often true" |next| self assert: ((self bytesInObject: chunk) = (index * self allocationUnit) and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit" and: [(self startOfObject: chunk) = chunk]]). + + "For some reason the assertion is not compiled correctly" + self cCode: '' inSmalltalk: [self assert: (self bytesBigEnoughForPrevPointer:(self bytesInObject: chunk)) = bytesBigEnoughForPrevPointer]. + - self assert: (self bytesBigEnoughForPrevPointer:(self bytesInObject: chunk)) = bytesBigEnoughForPrevPointer. freeLists at: index put: (next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). (bytesBigEnoughForPrevPointer and: [next ~= 0]) ifTrue: [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: 0]. ^chunk! Item was changed: ----- Method: SpurMemoryManager>>unlinkFreeChunk:chunkBytes: (in category 'free space') ----- unlinkFreeChunk: freeChunk chunkBytes: chunkBytes "Unlink a free object from the free lists. Do not alter totalFreeOldSpace. Used for coalescing." | index node next prev | index := chunkBytes / self allocationUnit. "Pathological 64 bits case - size 1 - single linked list" (self bytesBigEnoughForPrevPointer: chunkBytes) ifFalse: [node := freeLists at: index. prev := 0. [node ~= 0] whileTrue: [self assert: node = (self startOfObject: node). self assertValidFreeObject: node. next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. node = freeChunk ifTrue: [prev = 0 ifTrue: [self unlinkFreeChunk: freeChunk atIndex: index bytesBigEnoughForPrevPointer: false] ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: false]. + ^freeChunk]. - ^self]. prev := node. node := next]. self error: 'freeChunk not found in free list of size 1']. prev := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: freeChunk. "Has prev element: update double linked list" prev ~= 0 ifTrue: [self setNextFreeChunkOf: prev withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk) chunkBytes: chunkBytes. + ^freeChunk]. - ^self]. "Is the beginning of a list" "Small chunk" + (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue: + [self unlinkFreeChunk: freeChunk atIndex: index bytesBigEnoughForPrevPointer: true. + ^freeChunk]. - (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue: [ - ^self unlinkFreeChunk: freeChunk atIndex: index bytesBigEnoughForPrevPointer: true ]. "Large chunk" next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk. next = 0 ifTrue: "no list; remove the interior node" [self unlinkSolitaryFreeTreeNode: freeChunk] ifFalse: "list; replace node with it" + [self inFreeTreeReplace: freeChunk with: next]. + ^freeChunk - [self inFreeTreeReplace: freeChunk with: next] !

1 0

VM Maker: VMMaker.oscog-cb.2411.mcz
by commits＠source.squeak.org 08 Jun '18

08 Jun '18

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2411.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.2411 Author: cb Time: 8 June 2018, 11:00:37.380297 am UUID: 7cd561d6-86e8-4d00-8970-868454a406ae Ancestors: VMMaker.oscog-cb.2410 Improved assertion (we want to catch this case) =============== Diff against VMMaker.oscog-cb.2410 =============== Item was changed: ----- Method: Spur32BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) or: [fieldIndex = 0 "forwarders and free objs" + or: [fieldIndex = 1 and: [self isFreeObject: objOop]]]]). - or: [fieldIndex = 1]]]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was changed: ----- Method: Spur32BitMMLESimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) or: [fieldIndex = 0 "forwarders and free objs" + or: [fieldIndex = 1 and: [self isFreeObject: objOop]]]]). - or: [fieldIndex = 1]]]). ^super fetchPointer: fieldIndex ofObject: objOop!

1 0

Build failed: opensmalltalk-vm 1.0.1330
by AppVeyor 08 Jun '18

08 Jun '18

1 0

[OpenSmalltalk/opensmalltalk-vm] BuildSqueakSpurTrunkVMMakerImage.st sort versions, use FileAttributes… (#266)
by akgrant43 08 Jun '18

08 Jun '18

…Plugin.oscog BuildSqueakSpurTrunkVMMakerImage.st currently assumes that packages returned from a repository are sorted by version, however this doesn't appear to be true for smalltalkhub.com. - Sort packages by version to ensure the latest is used. - Load FileAttributesPlugin.oscog (which replaced FileAttributesPlugin) You can view, comment on, or merge this pull request online at: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/266 -- Commit Summary -- * BuildSqueakSpurTrunkVMMakerImage.st sort versions, use FileAttributesPlugin.oscog -- File Changes -- M image/BuildSqueakSpurTrunkVMMakerImage.st (13) -- Patch Links -- https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/266.patch https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/266.diff -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/266

1 2

← Newer
1
2
3
4
5
6
7
8
9
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev June 2018