Vm-dev December 2016

vm-dev@lists.squeakfoundation.org

34 participants
102 discussions

VM Maker: VMMaker.oscog-eem.2063.mcz
by commits＠source.squeak.org 31 Dec '16

31 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2063.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2063 Author: eem Time: 31 December 2016, 2:37:08.922183 pm UUID: 034eff8c-70b0-4106-b87e-a02a6a9aa506 Ancestors: VMMaker.oscog-eem.2062 SmartSyntaxPlugin Slang: Avoid generating unreachable code when failing. Avoid an unnecessary test for failed if returning an expression which can't fail. Nuke an unused method. =============== Diff against VMMaker.oscog-eem.2062 =============== Item was removed: - ----- Method: SmartSyntaxPluginTMethod>>checkSuccessExpr (in category 'private') ----- - checkSuccessExpr - "Return the parse tree for an expression that aborts the primitive if the successFlag is not true." - - | expr | - expr := 'interpreterProxy failed ifTrue: [^nil]'. - ^ self statementsFor: expr varName: '' - ! Item was changed: ----- Method: SmartSyntaxPluginTMethod>>fixUpReturnOneStmt:on: (in category 'transforming') ----- fixUpReturnOneStmt: stmt on: sStream stmt isReturn ifFalse: [^sStream nextPut: stmt]. (stmt expression isSend and: [#('primitiveFail' 'primitiveFailFor:') includes: stmt expression selector]) ifTrue: ["failure return" sStream nextPut: stmt expression. sStream nextPut: self nullReturnExpr. ^nil]. (stmt expression isVariable and: ['nil' = stmt expression name]) ifTrue: ["^ nil -- this is never right unless automatically generated" sStream nextPut: stmt. ^nil]. (stmt expression isVariable and: ['self' = stmt expression name]) ifTrue: ["^ self" self generateFailureGuardOn: sStream. fullArgs isEmpty ifFalse:[ sStream nextPut: (self popExpr: fullArgs size)]. sStream nextPut: self nullReturnExpr. ^nil]. (stmt expression isVariable | stmt expression isConstant | suppressingFailureGuards) ifTrue: ["^ variable or ^ constant or ^ expr without guardchecking" self generateFailureGuardOn: sStream. sStream nextPut: (self pop: fullArgs size + 1 thenReturnExpr: stmt expression). sStream nextPut: self nullReturnExpr. ^nil]. + "^ expr with necessary guard checking" - "^ expr with guardchecking" self generateFailureGuardOn: sStream. + (self resultExpressionAlwaysFails: stmt expression) + ifTrue: + [sStream nextPut: stmt expression] + ifFalse: + [sStream nextPut: (self assign: (self oopVariable: '_return_value') expression: stmt expression). + (self resultExpressionCanFail: stmt expression) ifTrue: + [self generateFailureGuardOn: sStream]. + sStream nextPut: (self pop: fullArgs size + 1 thenReturnExpr: (self oopVariable: '_return_value'))]. + sStream nextPut: self nullReturnExpr! - sStream nextPut: (self assign: (self oopVariable: '_return_value') expression: stmt expression). - self generateFailureGuardOn: sStream. - sStream nextPut: (self pop: fullArgs size + 1 thenReturnExpr: (self oopVariable: '_return_value')). - sStream nextPut: self nullReturnExpr - ! Item was removed: - ----- Method: SmartSyntaxPluginTMethod>>oldReplaceSizeMessages (in category 'private') ----- - oldReplaceSizeMessages - "Replace sends of the message 'size' with calls to sizeOfSTArrayFromCPrimitive." - - | argExpr | - parseTree nodesDo: [:n | - (n isSend and: [n selector = #size]) ifTrue: [ - argExpr := TSendNode new - setSelector: #+ - receiver: n receiver - arguments: (Array with: (TConstantNode new setValue: 1)). - n - setSelector: #sizeOfSTArrayFromCPrimitive: - receiver: (TVariableNode new setName: 'interpreterProxy') - arguments: (Array with: argExpr)]]. - ! Item was added: + ----- Method: SmartSyntaxPluginTMethod>>resultExpressionAlwaysFails: (in category 'private') ----- + resultExpressionAlwaysFails: aTSendNode + ^aTSendNode selector == #success: + and: [aTSendNode args first isConstant + and: [aTSendNode args first value == false]]! Item was added: + ----- Method: SmartSyntaxPluginTMethod>>resultExpressionCanFail: (in category 'private') ----- + resultExpressionCanFail: aTSendNode + "Neither asSmallIntegerObj nor asBooleanObj can fail." + ^(#(asSmallIntegerObj asBooleanObj) includes: aTSendNode selector) not!

1 0

VM Maker: VMMaker.oscog-eem.2062.mcz
by commits＠source.squeak.org 31 Dec '16

31 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2062.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2062 Author: eem Time: 31 December 2016, 12:46:31.161048 pm UUID: f42af46e-c315-4da9-8a34-aa300763e11c Ancestors: VMMaker.oscog-eem.2061 SpurPlanningCompactor: Fix "continue" enumeration (enumerating over an intervening run of immobile objects within the mobile objects) for update and copyAndUnmark. Abstract the forward operation to forwardMobileObject:to:savedFirstFieldPtr: for clarity and comment the purpose of the loop in the "continue" methods. Change the return value of copyAndUnmarkObject:to:firstField: to match forwardMobileObject:to:savedFirstFieldPtr:. The simulator successfully updated and snapshotted :-) =============== Diff against VMMaker.oscog-eem.2061 =============== Item was changed: ----- Method: SpurPlanningCompactor>>continueCopyAndUnmarkMobileObjectsFrom:withTop: (in category 'compaction') ----- + continueCopyAndUnmarkMobileObjectsFrom: anUnpinnedEntity withTop: initialTop - continueCopyAndUnmarkMobileObjectsFrom: anUnpinnedEntity withTop: top "copyAndUnmarkMobileObjects has encountered a run of pinned objects around which it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a new firstFreeObject, resetting it before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result top savedFirstFreeObject savedFirstMobileObject nextFreeObject | - | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). - savedFirstFreeObject := firstFreeObject. savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + top := initialTop. + "Copy and unmark the run of immobile objects to match the enumeration in continuePlanCompactSavingForwardersFrom:toFinger:." + manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do: + [:o| + (o < firstMobileObject + and: [manager isMarked: o]) ifTrue: + [(manager isPinned: o) + ifTrue: + [(manager isSegmentBridge: o) ifFalse: + [manager setIsMarkedOf: o to: false. + manager segmentManager notePinned: o]] + ifFalse: + [(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [^false]. + self assert: o = (manager fetchPointer: 0 ofObject: o). + manager + setIsMarkedOf: o to: false; + storePointerUnchecked: 0 ofObject: o withValue: (manager longAt: o)]]]. firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. + savedFirstFreeObject := firstFreeObject. firstFreeObject := nextFreeObject. result := self copyAndUnmarkMobileObjectsWithTop: top. firstFreeObject := savedFirstFreeObject. ^result! Item was changed: ----- Method: SpurPlanningCompactor>>continuePlanCompactSavingForwardersFrom:toFinger: (in category 'compaction') ----- continuePlanCompactSavingForwardersFrom: anUnpinnedEntity toFinger: initialToFinger "planCompactSavingForwarders has encountered a run of pinned objects around which it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a new firstFreeObject, resetting it before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result toFinger savedFirstMobileObject savedFirstFreeObject nextFreeObject | - | result toFinger savedFirstMobileObject nextFreeObject | self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). toFinger := initialToFinger. savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + "Forward the run of immobile objects since all unpinned objects between firstMobileObject + and lastMobileObject must be forwarded. Return if savedFirstFieldsSpace fills up." manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do: [:o| | newTop | (o < firstMobileObject and: [manager isMarked: o]) ifTrue: [(manager isPinned: o) ifTrue: [self assert: (manager addressAfter: o) <= initialToFinger] ifFalse: [(newTop := savedFirstFieldsSpace top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [firstMobileObject := savedFirstMobileObject. ^false]]. self assert: (manager startOfObject: o) >= toFinger. + toFinger := self forwardMobileObject: o to: toFinger savedFirstFieldPtr: newTop. + savedFirstFieldsSpace top: newTop]]. - manager - longAt: newTop - put: (manager fetchPointer: 0 ofObject: o); - storePointerUnchecked: 0 - ofObject: o - withValue: ((manager hasOverflowHeader: o) - ifTrue: [toFinger + manager baseHeaderSize] - ifFalse: [toFinger]). - savedFirstFieldsSpace top: newTop. - toFinger := toFinger + (manager bytesInObject: o). - lastMobileObject := o]]. firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. self assert: nextFreeObject > lastMobileObject. manager allOldSpaceEntitiesFrom: (manager objectAfter: lastMobileObject) to: nextFreeObject do: [:o| self deny: ((manager isMarked: o) and: [(manager isPinned: o) not])]. + savedFirstFreeObject := firstFreeObject. firstFreeObject := nextFreeObject. result := self planCompactSavingForwarders. + firstFreeObject := savedFirstFreeObject. ^result! Item was changed: ----- Method: SpurPlanningCompactor>>continueUpdatePointersInMobileObjectsFrom:withTop: (in category 'compaction') ----- + continueUpdatePointersInMobileObjectsFrom: anUnpinnedEntity withTop: initialTop - continueUpdatePointersInMobileObjectsFrom: anUnpinnedEntity withTop: top "updatePointersInMobileObjects has encountered a run of pinned objects around which planCompactSavingForwarders cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a new firstFreeObject , resetting it before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result top savedFirstFreeObject savedFirstMobileObject nextFreeObject | - | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). - savedFirstFreeObject := firstFreeObject. savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + top := initialTop. + "Update the run of immobile objects to match the enumeration in continuePlanCompactSavingForwardersFrom:toFinger:." + manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do: + [:o| + (o < firstMobileObject + and: [manager isMarked: o]) ifTrue: + [(manager isPinned: o) + ifTrue: [self updatePointersIn: o] + ifFalse: + [(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [^false]. + self updatePointersIn: o savedFirstFieldPointer: top]]]. firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. + savedFirstFreeObject := firstFreeObject. firstFreeObject := nextFreeObject. result := self updatePointersInMobileObjectsWithTop: top. firstFreeObject := savedFirstFreeObject. ^result! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjectsWithTop: (in category 'compaction') ----- copyAndUnmarkMobileObjectsWithTop: initialTop "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches those in planCompactSavingForwarders and updatePointersInMobileObjects." | toFinger top previousPin | toFinger := manager startOfObject: firstFreeObject. top := initialTop. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do: + [:o| - [:o| | availableSpace | self check: o. self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [(manager isSegmentBridge: o) ifFalse: [manager setIsMarkedOf: o to: false. manager segmentManager notePinned: o]. previousPin ifNotNil: [| limit | limit := manager startOfObject: previousPin. manager addFreeChunkWithBytes: limit - toFinger at: toFinger. toFinger := manager addressAfter: previousPin. self assert: toFinger < (manager startOfObject: o)]. previousPin := o] ifFalse: + [| availableSpace bytes next | - [| bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." availableSpace > 0 ifTrue: [manager addFreeChunkWithBytes: availableSpace at: toFinger]. toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: + [^self continueCopyAndUnmarkMobileObjectsFrom: o withTop: top - manager bytesPerOop]. - [^self continueCopyAndUnmarkMobileObjectsFrom: next withTop: top]. previousPin := (manager isPinned: next) ifTrue: [next]]. + toFinger := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top)]]]. - bytes := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top). - toFinger := toFinger + bytes]]]. self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkObject:to:firstField: (in category 'compaction') ----- copyAndUnmarkObject: o to: toFinger firstField: firstField "Copy the object to toFinger, clearing its mark bit and restoring its firstField, which was overwritten with a forwarding pointer. Answer the number of bytes in the object, including overflow header." <inline: true> | bytes numSlots destObj start | numSlots := manager rawNumSlotsOf: o. destObj := (manager objectWithRawSlotsHasOverflowHeader: numSlots) ifTrue: [toFinger + manager baseHeaderSize] ifFalse: [toFinger]. bytes := manager bytesInObject: o given: numSlots. start := manager startOfObject: o given: numSlots. manager mem: toFinger asVoidPointer cp: start asVoidPointer y: bytes; setIsMarkedOf: destObj to: false; storePointerUnchecked: 0 ofObject: destObj withValue: firstField. + ^toFinger + bytes! - ^bytes! Item was added: + ----- Method: SpurPlanningCompactor>>forwardMobileObject:to:savedFirstFieldPtr: (in category 'private') ----- + forwardMobileObject: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr + "Forward a mobile object to some new location, saving its first field through savedFirstFieldPtr. + Don't use forward:to:; we dont want to alter the object in any way other than by setting the forwarding pointer." + <inline: true> + lastMobileObject := o. + manager + longAt: savedFirstFieldPtr + put: (manager fetchPointer: 0 ofObject: o); + storePointerUnchecked: 0 + ofObject: o + withValue: ((manager hasOverflowHeader: o) + ifTrue: [toFinger + manager baseHeaderSize] + ifFalse: [toFinger]). + ^toFinger + (manager bytesInObject: o)! Item was changed: ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- planCompactSavingForwarders "Sweep the heap from firstFreeObject forwarding marked objects to where they can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). Note that this method is potentially recursive. If skipping a run of pinned objects causes the the algorithm to encounter another run of immobile objects it will recurse via continuePlanCompactSavingForwardersFrom:. This enumeration matches those in updatePointersInMobileObjects and copyAndUnmarkMobileObjects." | toFinger top previousPin | savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [self logPhase: 'planning...']. toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace top. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." [previousPin ifNotNil: [self assert: (manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2). toFinger := manager addressAfter: previousPin. self assert: toFinger < (manager startOfObject: o)]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [savedFirstFieldsSpace top: top - manager bytesPerOop. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: [savedFirstFieldsSpace top: top - manager bytesPerOop. ^self continuePlanCompactSavingForwardersFrom: o toFinger: toFinger]. previousPin := (manager isPinned: next) ifTrue: [next]]. + toFinger := self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top]]]. - lastMobileObject := o. - manager - longAt: top put: (manager fetchPointer: 0 ofObject: o); - storePointerUnchecked: 0 "Don't use forward:to:; we dont want to alter the object in any way other than by setting the forwarding pointer" - ofObject: o - withValue: ((manager hasOverflowHeader: o) - ifTrue: [toFinger + manager baseHeaderSize] - ifFalse: [toFinger]). - toFinger := toFinger + (manager bytesInObject: o)]]]. savedFirstFieldsSpace top: top. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointers (in category 'compaction') ----- updatePointers "Sweep the heap, updating all objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded." | onePass | self logPhase: 'updating pointers...'. "If savedFirstFieldsSpace is empty there is nothing to do." savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [^self]. + self assert: (manager startOfObject: firstFreeObject) = mobileStart. coInterpreter mapInterpreterOops. self updatePointersInManagerHeapEntities. self updatePointersInSurvivingObjects. self updatePointersInInitialImmobileObjects. onePass := self updatePointersInMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop. onePass ifFalse: [self updatePointersInObjectsOverflowingSavedFirstFieldsSpace]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjectsWithTop: (in category 'compaction') ----- updatePointersInMobileObjectsWithTop: initialTop "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects." | toFinger top previousPin | toFinger := manager startOfObject: firstFreeObject. top := initialTop. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." [self updatePointersIn: o. previousPin ifNotNil: [toFinger := manager addressAfter: previousPin]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: + [^self continueUpdatePointersInMobileObjectsFrom: o withTop: top - manager bytesPerOop]. - [^self continueUpdatePointersInMobileObjectsFrom: next withTop: top]. previousPin := (manager isPinned: next) ifTrue: [next]]. self updatePointersIn: o savedFirstFieldPointer: top. toFinger := toFinger + (manager bytesInObject: o)]]]. ^true!

1 0

VM Maker: VMMaker.oscog-eem.2061.mcz
by commits＠source.squeak.org 31 Dec '16

31 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2061.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2061 Author: eem Time: 31 December 2016, 10:45:17.323259 am UUID: ccfa5cc9-714b-40dc-abf1-b873b476a45a Ancestors: VMMaker.oscog-eem.2060 Simulator: Use Levente's lock-free growth of the externalSemaphoreSignalRequests/Responses code. Turn off logging in the SocketPluginSimulator now that it can do an update. SpurPlanningCompactor: Add an assert to check that all marked and unpinned objects in the mobile range are actually mobile, and hence uncover the bug in planCompactSavingForwarders. Fix the bug in planCompactSavingForwarders (the rest to follow). Add an interestingObject and halt the enumerations at it for debugging (simulation only). =============== Diff against VMMaker.oscog-eem.2060 =============== Item was changed: ----- Method: CogVMSimulator>>signalSemaphoreWithIndex: (in category 'process primitive support') ----- signalSemaphoreWithIndex: index + "This is a simulation. See platforms/Cross/vm/sqExternalSemaphores.c for the real code. + Thanks to Levente Uzoni for making this version almost thread-safe (in Smalltalk)" + <doNotGenerate> + | originalResponses newRequests newResponses | - "This is a non-thread-safe simulation. See platforms/Cross/vm/sqExternalSemaphores.c - for the real code." index <= 0 ifTrue: [^false]. index > externalSemaphoreSignalRequests size ifTrue: + [newRequests := Array new: 1 << index highBit withAll: 0. + newResponses := newRequests shallowCopy]. + "This is a lock-free thread-safe grow...; thanks Levente" + originalResponses := externalSemaphoreSignalResponses. + [index > externalSemaphoreSignalRequests size] whileTrue: + [newRequests - [| newRequests newResponses | - newRequests := Array new: 1 << index highBit withAll: 0. - newResponses := newRequests copy. - newRequests replaceFrom: 1 to: externalSemaphoreSignalRequests size with: externalSemaphoreSignalRequests startingAt: 1. + newResponses - newResponses replaceFrom: 1 to: externalSemaphoreSignalResponses size with: externalSemaphoreSignalResponses + startingAt: 1. + externalSemaphoreSignalResponses == originalResponses "This should always be true." + ifTrue: + [externalSemaphoreSignalRequests := newRequests. + externalSemaphoreSignalResponses := newResponses] + ifFalse: + [originalResponses := externalSemaphoreSignalResponses]]. + "This is not thread-safe however..." - startingAt: 1]. externalSemaphoreSignalRequests at: index put: (externalSemaphoreSignalRequests at: index) + 1. ^true! Item was changed: ----- Method: SocketPluginSimulator>>simulator: (in category 'accessing') ----- simulator: aSmartSyntaxPluginSimulator super simulator: aSmartSyntaxPluginSimulator. + "aSmartSyntaxPluginSimulator logging: true"! - aSmartSyntaxPluginSimulator logging: true! Item was added: + ----- Method: SpurMemoryManager>>allOldSpaceEntitiesFrom:to:do: (in category 'object enumeration') ----- + allOldSpaceEntitiesFrom: initialObject to: finalObject do: aBlock + <inline: true> + | prevObj prevPrevObj objOop | + self assert: ((self isNonImmediate: initialObject) and: [segmentManager isInSegments: initialObject]). + self assert: ((self isNonImmediate: finalObject) and: [segmentManager isInSegments: finalObject]). + prevPrevObj := prevObj := nil. + objOop := initialObject. + [self assert: objOop \\ self allocationUnit = 0. + self oop: objOop isLessThanOrEqualTo: finalObject] whileTrue: + [self assert: (self long64At: objOop) ~= 0. + aBlock value: objOop. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := self objectAfter: objOop limit: endOfMemory]. + self touch: prevPrevObj. + self touch: prevObj! Item was changed: CogClass subclass: #SpurPlanningCompactor + instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceWasAllocated firstFieldOfRememberedSet interestingObj anomaly' - instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceWasAllocated firstFieldOfRememberedSet' classVariableNames: '' poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMBytecodeConstants VMSpurObjectRepresentationConstants' category: 'VMMaker-SpurMemoryManager'! !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. Instance Variables biasForGC <Boolean> coInterpreter: <StackInterpreter> firstFieldOfRememberedSet <Oop> firstFreeObject <Oop> firstMobileObject <Oop> lastMobileObject <Oop> manager: <SpurMemoryManager> savedFirstFieldsSpace <SpurContiguousObjStack> savedFirstFieldsSpaceWasAllocated <Boolean> scavenger: <SpurGenerationScavenger> 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. 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:! Item was changed: ----- Method: SpurPlanningCompactor class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator + aCCodeGenerator + var: 'savedFirstFieldsSpace' type: #SpurContiguousObjStack; + removeVariable: 'interestingObj'! - aCCodeGenerator var: 'savedFirstFieldsSpace' type: #SpurContiguousObjStack! Item was added: + ----- Method: SpurPlanningCompactor>>check: (in category 'private') ----- + check: obj + <inline: true> + self cCode: '' inSmalltalk: [obj = interestingObj ifTrue: [self halt]]! Item was changed: ----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') ----- compact "Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects. Let the segmentManager mark which segments contain pinned objects via notePinned:." | onePass | <inline: #never> "for profiling" self initializeScanCheckingForFullyCompactedHeap ifTrue: [^self unmarkObjectsInFullyCompactedHeap]. self initializeCompaction. [onePass := self planCompactSavingForwarders. + self assert: (self validRelocationPlanInPass: onePass) = 0. self updatePointers. self copyAndUnmark. manager checkFreeSpace: GCModeFull. onePass or: [biasForGC]] whileFalse: [self reinitializeScan; updateSavedFirstFieldsSpaceIfNecessary]. self endCompaction! Item was removed: - ----- Method: SpurPlanningCompactor>>continuePlanCompactSavingForwardersFrom: (in category 'compaction') ----- - continuePlanCompactSavingForwardersFrom: anUnpinnedEntity - "planCompactSavingForwarders has encountered a run of pinned objects around which - it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a - new firstFreeObject, resetting it before continuing. - Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." - | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | - self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). - self deny: (manager isPinned: anUnpinnedEntity). - savedFirstFreeObject := firstFreeObject. - savedFirstMobileObject := firstMobileObject. - nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. - firstMobileObject := savedFirstMobileObject. - nextFreeObject ifNil: - [^true]. - firstFreeObject := nextFreeObject. - result := self planCompactSavingForwarders. - firstFreeObject := savedFirstFreeObject. - ^result! Item was added: + ----- Method: SpurPlanningCompactor>>continuePlanCompactSavingForwardersFrom:toFinger: (in category 'compaction') ----- + continuePlanCompactSavingForwardersFrom: anUnpinnedEntity toFinger: initialToFinger + "planCompactSavingForwarders has encountered a run of pinned objects around which + it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a + new firstFreeObject, resetting it before continuing. + Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result toFinger savedFirstMobileObject nextFreeObject | + self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). + self deny: (manager isPinned: anUnpinnedEntity). + toFinger := initialToFinger. + savedFirstMobileObject := firstMobileObject. + nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do: + [:o| | newTop | + (o < firstMobileObject + and: [manager isMarked: o]) ifTrue: + [(manager isPinned: o) + ifTrue: [self assert: (manager addressAfter: o) <= initialToFinger] + ifFalse: + [(newTop := savedFirstFieldsSpace top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [firstMobileObject := savedFirstMobileObject. + ^false]]. + self assert: (manager startOfObject: o) >= toFinger. + manager + longAt: newTop + put: (manager fetchPointer: 0 ofObject: o); + storePointerUnchecked: 0 + ofObject: o + withValue: ((manager hasOverflowHeader: o) + ifTrue: [toFinger + manager baseHeaderSize] + ifFalse: [toFinger]). + savedFirstFieldsSpace top: newTop. + toFinger := toFinger + (manager bytesInObject: o). + lastMobileObject := o]]. + firstMobileObject := savedFirstMobileObject. + nextFreeObject ifNil: + [^true]. + self assert: nextFreeObject > lastMobileObject. + manager allOldSpaceEntitiesFrom: (manager objectAfter: lastMobileObject) to: nextFreeObject do: + [:o| + self deny: ((manager isMarked: o) and: [(manager isPinned: o) not])]. + firstFreeObject := nextFreeObject. + result := self planCompactSavingForwarders. + ^result! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjectsWithTop: (in category 'compaction') ----- copyAndUnmarkMobileObjectsWithTop: initialTop "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches those in planCompactSavingForwarders and updatePointersInMobileObjects." | toFinger top previousPin | toFinger := manager startOfObject: firstFreeObject. top := initialTop. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do: [:o| | availableSpace | + self check: o. self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [(manager isSegmentBridge: o) ifFalse: [manager setIsMarkedOf: o to: false. manager segmentManager notePinned: o]. previousPin ifNotNil: [| limit | limit := manager startOfObject: previousPin. manager addFreeChunkWithBytes: limit - toFinger at: toFinger. toFinger := manager addressAfter: previousPin. self assert: toFinger < (manager startOfObject: o)]. previousPin := o] ifFalse: [| bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." availableSpace > 0 ifTrue: [manager addFreeChunkWithBytes: availableSpace at: toFinger]. toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: [^self continueCopyAndUnmarkMobileObjectsFrom: next withTop: top]. previousPin := (manager isPinned: next) ifTrue: [next]]. bytes := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top). toFinger := toFinger + bytes]]]. self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. ^true! Item was added: + ----- Method: SpurPlanningCompactor>>interestingObj: (in category 'instance initialization') ----- + interestingObj: obj + interestingObj := obj! Item was changed: ----- Method: SpurPlanningCompactor>>isMobile: (in category 'private') ----- isMobile: obj <inline: true> + ^(self oop: obj isGreaterThanOrEqualTo: mobileStart andLessThanOrEqualTo: lastMobileObject) - ^(self oop: obj isGreaterThanOrEqualTo: firstMobileObject andLessThanOrEqualTo: lastMobileObject) and: [(manager isPinned: obj) not]! Item was changed: ----- Method: SpurPlanningCompactor>>isPostMobile: (in category 'private') ----- isPostMobile: obj "For asserts" + ^self oop: obj isGreaterThanOrEqualTo: mobileStart andLessThanOrEqualTo: lastMobileObject! - ^self oop: obj isGreaterThanOrEqualTo: firstFreeObject andLessThanOrEqualTo: lastMobileObject! Item was changed: ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- planCompactSavingForwarders "Sweep the heap from firstFreeObject forwarding marked objects to where they can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). Note that this method is potentially recursive. If skipping a run of pinned objects causes the the algorithm to encounter another run of immobile objects it will recurse via continuePlanCompactSavingForwardersFrom:. This enumeration matches those in updatePointersInMobileObjects and copyAndUnmarkMobileObjects." | toFinger top previousPin | savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [self logPhase: 'planning...']. toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace top. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| + self check: o. self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." [previousPin ifNotNil: [self assert: (manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2). toFinger := manager addressAfter: previousPin. self assert: toFinger < (manager startOfObject: o)]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [savedFirstFieldsSpace top: top - manager bytesPerOop. - [savedFirstFieldsSpace top: top. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: + [savedFirstFieldsSpace top: top - manager bytesPerOop. + ^self continuePlanCompactSavingForwardersFrom: o toFinger: toFinger]. - [savedFirstFieldsSpace top: top. - ^self continuePlanCompactSavingForwardersFrom: next]. previousPin := (manager isPinned: next) ifTrue: [next]]. lastMobileObject := o. manager longAt: top put: (manager fetchPointer: 0 ofObject: o); storePointerUnchecked: 0 "Don't use forward:to:; we dont want to alter the object in any way other than by setting the forwarding pointer" ofObject: o withValue: ((manager hasOverflowHeader: o) ifTrue: [toFinger + manager baseHeaderSize] ifFalse: [toFinger]). toFinger := toFinger + (manager bytesInObject: o)]]]. savedFirstFieldsSpace top: top. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>reinitializeScan (in category 'compaction') ----- reinitializeScan firstMobileObject := manager endOfMemory. firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: firstFreeObject. firstFreeObject ifNil: + [self error: 'uncompactable heap; no unmarked objects found']. + mobileStart := manager startOfObject: firstFreeObject! - [self error: 'uncompactable heap; no unmarked objects found']! Item was changed: ----- Method: SpurPlanningCompactor>>unmarkInitialImmobileObjects (in category 'compaction') ----- unmarkInitialImmobileObjects "Sweep the initial immobile heap, unmarking all objects up to the first mobile object." manager allOldSpaceObjectsFrom: manager firstObject do: [:o| + self check: o. o >= firstMobileObject ifTrue: [^self]. manager setIsMarkedOf: o to: false]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInInitialImmobileObjects (in category 'compaction') ----- updatePointersInInitialImmobileObjects "Sweep the initial immobile heap, updating all references to mobile objects to their eventual locations." manager allOldSpaceObjectsFrom: manager firstObject do: [:o| + self check: o. o >= firstFreeObject ifTrue: [^self]. self assert: (manager isMarked: o). self updatePointersIn: o]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjectsWithTop: (in category 'compaction') ----- updatePointersInMobileObjectsWithTop: initialTop "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects." | toFinger top previousPin | toFinger := manager startOfObject: firstFreeObject. top := initialTop. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| + self check: o. self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." [self updatePointersIn: o. previousPin ifNotNil: [toFinger := manager addressAfter: previousPin]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: [^self continueUpdatePointersInMobileObjectsFrom: next withTop: top]. previousPin := (manager isPinned: next) ifTrue: [next]]. self updatePointersIn: o savedFirstFieldPointer: top. toFinger := toFinger + (manager bytesInObject: o)]]]. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInObjectsOverflowingSavedFirstFieldsSpace (in category 'compaction') ----- updatePointersInObjectsOverflowingSavedFirstFieldsSpace "Sweep the final immobile heap, is any (those objects with no room in savedFirstFieldsSpace in the current pass) updating all references to mobile objects to their eventual locations." manager allOldSpaceObjectsFrom: (manager objectAfter: lastMobileObject) do: [:o| + self check: o. self assert: (manager isMarked: o). self updatePointersIn: o]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInSurvivingObjects (in category 'compaction') ----- updatePointersInSurvivingObjects "Sweep pastSpace, updating all references to mobile objects to their eventual locations." manager allPastSpaceObjectsDo: [:o| + self check: o. self assert: (manager isMarked: o). self updatePointersIn: o]! Item was added: + ----- Method: SpurPlanningCompactor>>validRelocationPlanInPass: (in category 'private') ----- + validRelocationPlanInPass: onePass + "Answer 0 if all the mobile objects from firstMobileObject to lastMobileObject + have sane forwarding addresses, and that savedFirstFieldsSpace is of + matching capacity. Otherwise answer an error code identifying the anomaly." + | nMobiles toFinger | + nMobiles := 0. + toFinger := mobileStart. + anomaly := nil. + manager allOldSpaceEntitiesFrom: firstMobileObject do: + [:o| | destination | + self check: o. + (manager isMarked: o) ifTrue: + [(manager isPinned: o) ifFalse: + [nMobiles := nMobiles + 1. + destination := manager fetchPointer: 0 ofObject: o. + destination >= toFinger ifFalse: + [anomaly := o. ^1]. + toFinger := toFinger + (manager bytesInObject: o). + o > lastMobileObject ifTrue: + [anomaly := o. ^2]. + o = lastMobileObject ifTrue: + [^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1 + = nMobiles + ifTrue: [0] + ifFalse: [3]]]]]. + ^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1 + = nMobiles + ifTrue: [0] + ifFalse: [3]! Item was changed: ----- Method: StackInterpreterSimulator>>signalSemaphoreWithIndex: (in category 'process primitive support') ----- signalSemaphoreWithIndex: index + "This is a simulation. See platforms/Cross/vm/sqExternalSemaphores.c for the real code. + Thanks to Levente Uzoni for making this version almost thread-safe (in Smalltalk)" + <doNotGenerate> + | originalResponses newRequests newResponses | - "This is a non-thread-safe simulation. See platforms/Cross/vm/sqExternalSemaphores.c - for the real code." index <= 0 ifTrue: [^false]. index > externalSemaphoreSignalRequests size ifTrue: + [newRequests := Array new: 1 << index highBit withAll: 0. + newResponses := newRequests shallowCopy]. + "This is a lock-free thread-safe grow...; thanks Levente" + originalResponses := externalSemaphoreSignalResponses. + [index > externalSemaphoreSignalRequests size] whileTrue: + [newRequests - [| newRequests newResponses | - newRequests := Array new: 1 << index highBit withAll: 0. - newResponses := newRequests copy. - newRequests replaceFrom: 1 to: externalSemaphoreSignalRequests size with: externalSemaphoreSignalRequests startingAt: 1. + newResponses - newResponses replaceFrom: 1 to: externalSemaphoreSignalResponses size with: externalSemaphoreSignalResponses startingAt: 1. + externalSemaphoreSignalResponses == originalResponses "This should always be true." + ifTrue: + [externalSemaphoreSignalRequests := newRequests. + externalSemaphoreSignalResponses := newResponses] + ifFalse: + [originalResponses := externalSemaphoreSignalResponses]]. + "This is not thread-safe however..." - externalSemaphoreSignalRequests := newRequests. - externalSemaphoreSignalResponses := newResponses]. externalSemaphoreSignalRequests at: index put: (externalSemaphoreSignalRequests at: index) + 1. ^true!

1 0

VM Maker: VMMaker.oscog-eem.2059.mcz
by commits＠source.squeak.org 31 Dec '16

31 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2059.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2059 Author: eem Time: 30 December 2016, 4:32:26.95142 pm UUID: fc6d415a-2e9d-4a42-abae-71dce27c857a Ancestors: VMMaker.oscog-eem.2058 SmartSyntaxPluginSimulator Simplify getting at the interpreterProxy and hence streamline asSmallIntegerObj et al. Add support for logging (print frame, primitive selecvtor and result). =============== Diff against VMMaker.oscog-eem.2058 =============== Item was added: + ----- Method: Boolean>>asBooleanObj (in category '*VMMaker-interpreter simulator') ----- + asBooleanObj + ^(Notification new tag: #getInterpreter; signal) + ifNotNil: [:interpreter| interpreter booleanObjectOf: self] + ifNil: [self]! Item was changed: ----- Method: Integer>>asCharPtr (in category '*VMMaker-interpreter simulator') ----- asCharPtr + ^(Notification new tag: #getInterpreter; signal) + ifNotNil: [:interpreter| - ^(Notification new tag: #getSimulator; signal) - ifNotNil: [:simulator| | interpreter | - interpreter := simulator getInterpreter. (interpreter firstIndexableField: self) asInteger coerceTo: #'char *' sim: interpreter] ifNil: [self]! Item was changed: ----- Method: Integer>>asSmallIntegerObj (in category '*VMMaker-interpreter simulator') ----- asSmallIntegerObj + ^(Notification new tag: #getInterpreter; signal) + ifNotNil: [:interpreter| interpreter integerObjectOf: self] - ^(Notification new tag: #getSimulator; signal) - ifNotNil: [:simulator| simulator getInterpreter integerObjectOf: self] ifNil: [self]! Item was changed: ----- Method: Object>>stAt: (in category '*VMMaker-translation support') ----- stAt: index "Simulation of generateStAt:on:indent:" + ^(Notification new tag: #getInterpreter; signal) + ifNotNil: [:interpreter| interpreter stObject: self at: index] - ^(Notification new tag: #getSimulator; signal) - ifNotNil: [:simulator| simulator stObject: self at: index] ifNil: [self at: index]! Item was changed: ----- Method: Object>>stAt:put: (in category '*VMMaker-translation support') ----- stAt: index put: value "Simulation of generateStAtPut:on:indent:" + ^(Notification new tag: #getInterpreter; signal) + ifNotNil: [:interpreter| interpreter stObject: self at: index put: value] - ^(Notification new tag: #getSimulator; signal) - ifNotNil: [:simulator| simulator getInterpreter stObject: self at: index put: value] ifNil: [self at: index put: value]! Item was changed: InterpreterPlugin subclass: #SmartSyntaxPluginSimulator + instanceVariableNames: 'actualPlugin signatureMap forMap pluginClass logging' - instanceVariableNames: 'actualPlugin signatureMap forMap pluginClass' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-SmartSyntaxPlugins'! Item was changed: ----- Method: SmartSyntaxPluginSimulator>>doesNotUnderstand: (in category 'message forwarding') ----- doesNotUnderstand: aMessage | signature selector parameters result | signature := signatureMap at: aMessage selector ifAbsent: [^super doesNotUnderstand: aMessage]. + self log: [interpreterProxy coInterpreter printExternalHeadFrame; print: aMessage selector; cr]. selector := signature first. parameters := signature second. signature third "receiver block" value: (interpreterProxy stackValue: parameters size). interpreterProxy failed ifTrue: + [self log: 'failed in marshalling'. + ^nil]. - [^nil]. result := [actualPlugin perform: selector withArguments: (parameters withIndexCollect: [:block :index| block value: (interpreterProxy stackValue: parameters size - index)])] on: Notification do: [:ex| + ex tag == #getInterpreter ifTrue: [ex resume: interpreterProxy] ifFalse: + [ex tag == #getSimulator ifTrue: [ex resume: self] + ifFalse: [ex pass]]]. - ex tag == #getSimulator - ifTrue: [ex resume: self] - ifFalse: [ex pass]]. interpreterProxy failed ifTrue: + [self log: 'failed in execution'. + ^nil]. - [^nil]. result == actualPlugin ifTrue: + [self log: '^self'. + interpreterProxy pop: interpreterProxy methodArgumentCount. - [interpreterProxy pop: interpreterProxy methodArgumentCount. ^nil]. + self log: [interpreterProxy coInterpreter print: '^'; shortPrintOop: result; flush]. interpreterProxy pop: interpreterProxy methodArgumentCount + 1 thenPush: result. ^nil "SmartSyntaxPluginPrimitives return null"! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>log: (in category 'simulation support') ----- + log: aBlockOrString + logging ifTrue: + [aBlockOrString isBlock + ifTrue: [aBlockOrString value] + ifFalse: [interpreterProxy coInterpreter print: aBlockOrString; cr; flush]]! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>logging (in category 'accessing') ----- + logging + ^logging! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>logging: (in category 'accessing') ----- + logging: anObject + logging := anObject! Item was changed: ----- Method: SmartSyntaxPluginSimulator>>setInterpreter: (in category 'initialize') ----- setInterpreter: anInterpreterProxy interpreterProxy := anInterpreterProxy. actualPlugin setInterpreter: anInterpreterProxy. + logging ifNil: [logging := false]. self computeSignatureMap!

1 0

VM Maker: VMMaker.oscog-eem.2058.mcz
by commits＠source.squeak.org 30 Dec '16

30 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2058.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2058 Author: eem Time: 29 December 2016, 5:25:46.509315 pm UUID: 0404f168-043b-4376-89e3-1340adf9c797 Ancestors: VMMaker.oscog-eem.2057 Simulator: Add a Processor yield to doSignalExternalSemaphores: so that e.g. background processes in teh SocketPluginSimulator will get a chance to run more frequently than if ythe yield we in ioProcessEvents. Fix the new implementation of asCharPtr; it should coerce the firstIndexableField:. Fix the new generic plugin closing. Implement windowIsClosing in the stack interpreter sim. =============== Diff against VMMaker.oscog-eem.2057 =============== Item was changed: CoInterpreterMT subclass: #CogVMSimulator + instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends traceOn myBitBlt displayForm fakeForm imageName pluginList mappedPluginEntries quitBlock transcript displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters eventQueue expectedSends expecting' - instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends traceOn myBitBlt displayForm fakeForm imageName pluginList mappedPluginEntries quitBlock transcript displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters eventQueue expectedSends expecting' classVariableNames: 'ByteCountsPerMicrosecond ExpectedSends' poolDictionaries: '' category: 'VMMaker-JITSimulation'! !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0! This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. Remember that you can test the Cogit using its class-side in-image compilation facilities. To see the thing actually run, you could (after backing up this image and changes), execute (CogVMSimulator new openOn: Smalltalk imageName) test and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. Here's an example to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff: (CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit)) desiredNumStackPages: 8; openOn: '/Users/eliot/Cog/startreader.image'; openAsMorph; run Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out. | cos proc opts | CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)). CogVMSimulator chooseAndInitCogitClassWithOpts: opts. cos := CogVMSimulator new. "cos initializeThreadSupport." "to test the multi-threaded VM" cos desiredNumStackPages: 8. "to set the size of the stack zone" "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone" cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image" "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector" proc := cos cogit processor. "cos cogit sendTrace: 7." "turn on tracing" "set a complex breakpoint at a specific point in machine code" "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg| cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1". "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit" "cos cogit setBreakMethod: 16rB38880." cos openAsMorph; "toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window" halt; run! Item was changed: ----- Method: CogVMSimulator>>close (in category 'initialization') ----- close "close any files that ST may have opened, etc" + pluginList do: [:plugin| plugin ~~ self ifTrue: [plugin close]]! - pluginList do: [:plugin| (plugin ~~ self and: [plugin respondsTo: #close]) ifTrue: [plugin close]]! Item was changed: ----- Method: CogVMSimulator>>doSignalExternalSemaphores: (in category 'process primitive support') ----- doSignalExternalSemaphores: minTableSize "This is a non-thread-safe simulation. See platforms/Cross/vm/sqExternalSemaphores.c + for the real code. For the benefit of the SocketPluginSimulator, do a yield every 100 + virtual microseconds." + | now switched | + now := self ioUTCMicroseconds. + now - lastYieldMicroseconds >= 100 ifTrue: + [lastYieldMicroseconds := now. + Processor yield]. + - for the real code." - | switched | switched := false. 1 to: (minTableSize min: externalSemaphoreSignalRequests size) do: [:i| | responses | responses := externalSemaphoreSignalResponses at: i. [responses < (externalSemaphoreSignalRequests at: i)] whileTrue: [(self doSignalSemaphoreWithIndex: i) ifTrue: [switched := true]. externalSemaphoreSignalResponses at: i put: (responses := responses + 1)]]. ^switched! Item was changed: ----- Method: CogVMSimulator>>initialize (in category 'initialization') ----- initialize "Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." super initialize. transcript := Transcript. objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. cogit ifNil: [cogit := self class cogitClass new setInterpreter: self]. objectMemory coInterpreter: self cogit: cogit. cogit numRegArgs > 0 ifTrue: [debugStackDepthDictionary := Dictionary new]. cogThreadManager ifNotNil: [super initialize]. self assert: ConstMinusOne = (objectMemory integerObjectOf: -1). cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())" enableCog := true. methodCache := Array new: MethodCacheSize. nsMethodCache := Array new: NSMethodCacheSize. atCache := nil. self flushMethodCache. cogCompiledCodeCompactionCalledFor := false. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. mappedPluginEntries := OrderedCollection new. objectMemory hasSpurMemoryManagerAPI ifTrue: [primitiveAccessorDepthTable := Array new: primitiveTable size. pluginList := {}. self loadNewPlugin: ''] ifFalse: [pluginList := {'' -> self }]. desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. + startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds. - startMicroseconds := self ioUTCStartMicroseconds. maxLiteralCountForCompile := MaxLiteralCountForCompile. minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile. flagInterpretedMethods := false. "initialize InterpreterSimulator variables used for debugging" byteCount := lastPollCount := sendCount := lookupCount := 0. quitBlock := [^self close]. traceOn := true. printSends := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form. eventQueue := SharedQueue new. suppressHeartbeatFlag := deferSmash := deferredSmash := false. systemAttributes := Dictionary new. primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0). primTraceLogIndex := 0. traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0). traceLogIndex := 0. traceSources := TraceSources. statCodeCompactionCount := 0. statCodeCompactionUsecs := 0. extSemTabSize := 256! Item was changed: ----- Method: Integer>>asCharPtr (in category '*VMMaker-interpreter simulator') ----- asCharPtr ^(Notification new tag: #getSimulator; signal) + ifNotNil: [:simulator| | interpreter | + interpreter := simulator getInterpreter. + (interpreter firstIndexableField: self) asInteger + coerceTo: #'char *' + sim: interpreter] - ifNotNil: [:simulator| self coerceTo: #'char *' sim: simulator getInterpreter] ifNil: [self]! Item was added: + ----- Method: InterpreterPlugin>>close (in category 'simulation support') ----- + close + "Simulation subclasses needing some specific close action override as required." + <doNotGenerate>! Item was changed: StackInterpreterPrimitives subclass: #StackInterpreterSimulator + instanceVariableNames: 'parent bootstrapping byteCount breakCount sendCount lookupCount printSends printReturns traceOn myBitBlt displayForm fakeForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES' - instanceVariableNames: 'parent bootstrapping byteCount breakCount sendCount lookupCount printSends printReturns traceOn myBitBlt displayForm fakeForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-InterpreterSimulation'! !StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0! This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. To see the thing actually run, you could (after backing up this image and changes), execute (StackInterpreterSimulator new openOn: Smalltalk imageName) test ((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true)) openOn: 'ns101.image') test and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. Here's an example of what Eliot uses to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff: | vm | vm := StackInterpreterSimulator newWithOptions: #(). vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. vm setBreakSelector: #&. vm openAsMorph; run! Item was changed: ----- Method: StackInterpreterSimulator>>close (in category 'initialization') ----- close "close any files that ST may have opened, etc" + pluginList do: [:assoc| | plugin | plugin := assoc value. plugin ~~ self ifTrue: [plugin close]]! - pluginList do: [:plugin| (plugin ~~ self and: [plugin respondsTo: #close]) ifTrue: [plugin close]]! Item was changed: ----- Method: StackInterpreterSimulator>>doSignalExternalSemaphores: (in category 'process primitive support') ----- doSignalExternalSemaphores: minTableSize "This is a non-thread-safe simulation. See platforms/Cross/vm/sqExternalSemaphores.c + for the real code. For the benefit of the SocketPluginSimulator, do a yield every 100 + virtual microseconds." + | now switched | + now := self ioUTCMicroseconds. + now - lastYieldMicroseconds >= 100 ifTrue: + [lastYieldMicroseconds := now. + Processor yield]. + - for the real code." - | switched | switched := false. 1 to: (minTableSize min: externalSemaphoreSignalRequests size) do: [:i| | responses | responses := externalSemaphoreSignalResponses at: i. [responses < (externalSemaphoreSignalRequests at: i)] whileTrue: [(self doSignalSemaphoreWithIndex: i) ifTrue: [switched := true]. externalSemaphoreSignalResponses at: i put: (responses := responses + 1)]]. ^switched! Item was changed: ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') ----- initialize "Initialize the StackInterpreterSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." super initialize. bootstrapping := false. transcript := Transcript. objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. objectMemory coInterpreter: self. self assert: ConstMinusOne = (objectMemory integerObjectOf: -1). methodCache := Array new: MethodCacheSize. nsMethodCache := Array new: NSMethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. mappedPluginEntries := OrderedCollection new. objectMemory hasSpurMemoryManagerAPI ifTrue: [primitiveAccessorDepthTable := Array new: primitiveTable size. pluginList := {}. self loadNewPlugin: ''] ifFalse: [pluginList := {'' -> self }]. desiredNumStackPages := desiredEdenBytes := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. + startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds. - startMicroseconds := self ioUTCStartMicroseconds. "initialize InterpreterSimulator variables used for debugging" byteCount := sendCount := lookupCount := 0. quitBlock := [^self close]. traceOn := true. printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form. eventQueue := SharedQueue new. suppressHeartbeatFlag := false. systemAttributes := Dictionary new. extSemTabSize := 256. disableBooleanCheat := false. assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"! Item was added: + ----- Method: StackInterpreterSimulator>>windowIsClosing (in category 'primitive support') ----- + windowIsClosing + quitBlock ifNotNil: + [:effectiveQuitBlock| + quitBlock := nil. "stop recursion on explicit window close." + [effectiveQuitBlock value] + on: BlockCannotReturn + do: [:ex|]] "Cause return from #test, et al"!

1 0

VM Maker: VMMaker.oscog-eem.2057.mcz
by commits＠source.squeak.org 29 Dec '16

29 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2057.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2057 Author: eem Time: 29 December 2016, 9:06:52.675429 am UUID: 183112c3-adba-4e59-870e-c99e09343e23 Ancestors: VMMaker.oscog-eem.2056 SmartSyntaxPluginSimulator: Fix several bugs with smart syntax operations (cPtrAsOop asSmallIntegerObj et al) that weren't being simulated. Delete Object>>primitive: and implement it in SmartSyntaxInterpreterPlugin & SmartSyntaxPluginSimulator to be able to collect the signatures of zero-arg smart syntax prims. Extend SmartSyntaxPluginSimulator instantiation to include a simulator subclass if one exists (the simulatorClass has to remain SmartSyntaxPluginSimulator to get the wrapping and marshalling on forwarding to work). Fix returning self in SmartSyntaxPluginSimulator>>doesNotUnderstand: Implement the ccgLoad:*andThen: methods. FIx coercion of the byteArrayArg in the FilePluginSimulator read and write methods. =============== Diff against VMMaker.oscog-eem.2056 =============== Item was changed: ----- Method: CArray>>cPtrAsOop (in category 'accessing') ----- cPtrAsOop + ptrOffset = 0 ifFalse: [self error: 'offset must be zero']. + ^arrayBaseAddress - interpreter baseHeaderSize! - ^arrayBaseAddress + ptrOffset! Item was changed: ----- Method: FilePluginSimulator>>sqFile:Read:Into:At: (in category 'simulation') ----- sqFile: file Read: count Into: byteArrayIndexArg At: startIndex | interpreter byteArrayIndex | interpreter := interpreterProxy interpreter. + byteArrayIndex := byteArrayIndexArg asInteger. "Coerces CArray et al correctly" - byteArrayIndex := byteArrayIndexArg isInteger ifTrue: [byteArrayIndexArg] ifFalse: [byteArrayIndexArg cPtrAsOop]. [[startIndex to: startIndex + count - 1 do: [ :i | file atEnd ifTrue: [(file isKindOf: FakeStdinStream) ifTrue: [file atEnd: false]. ^i - startIndex]. interpreter byteAt: byteArrayIndex + i put: (file next ifNil: [(file isKindOf: FakeStdinStream) ifTrue: [^0]] ifNotNil: [:c| c asInteger])]] on: Error do: [:ex| (file isKindOf: TranscriptStream) ifFalse: [ex pass]. ^0]] ensure: [self recordStateOf: file]. ^count! Item was changed: ----- Method: FilePluginSimulator>>sqFile:Write:From:At: (in category 'simulation') ----- sqFile: file Write: count From: byteArrayIndexArg At: startIndex | interpreter byteArrayIndex | interpreter := interpreterProxy interpreter. + byteArrayIndex := byteArrayIndexArg asInteger. "Coerces CArray et al correctly" - byteArrayIndex := byteArrayIndexArg isInteger ifTrue: [byteArrayIndexArg] ifFalse: [byteArrayIndexArg cPtrAsOop]. file isBinary ifTrue: [startIndex to: startIndex + count - 1 do: [ :i | file nextPut: (interpreter byteAt: byteArrayIndex + i)]] ifFalse: [startIndex to: startIndex + count - 1 do: [ :i | | byte | byte := interpreter byteAt: byteArrayIndex + i. file nextPut: (Character value: (byte == 12 "lf" ifTrue: [15"cr"] ifFalse: [byte]))]]. self recordStateOf: file. ^count! Item was added: + ----- Method: Integer>>asCharPtr (in category '*VMMaker-interpreter simulator') ----- + asCharPtr + ^(Notification new tag: #getSimulator; signal) + ifNotNil: [:simulator| self coerceTo: #'char *' sim: simulator getInterpreter] + ifNil: [self]! Item was added: + ----- Method: Integer>>asSmallIntegerObj (in category '*VMMaker-interpreter simulator') ----- + asSmallIntegerObj + ^(Notification new tag: #getSimulator; signal) + ifNotNil: [:simulator| simulator getInterpreter integerObjectOf: self] + ifNil: [self]! Item was removed: - ----- Method: Object>>asSmallIntegerObj (in category '*VMMaker-translation support') ----- - asSmallIntegerObj - - ^self! Item was removed: - ----- Method: Object>>primitive: (in category '*VMMaker-translation support') ----- - primitive: primName - "For translation only; noop when running in Smalltalk."! Item was added: + ----- Method: SmartSyntaxInterpreterPlugin>>primitive: (in category 'simulation') ----- + primitive: primName + <doNotGenerate> + ^simulator primitive: primName! Item was changed: InterpreterPlugin subclass: #SmartSyntaxPluginSimulator + instanceVariableNames: 'actualPlugin signatureMap forMap pluginClass' - instanceVariableNames: 'actualPlugin signatureMap forMap' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-SmartSyntaxPlugins'! Item was changed: ----- Method: SmartSyntaxPluginSimulator class>>newFor: (in category 'simulation') ----- newFor: anUnsimulatedInterpreterPluginClass + | simulatorClass | + simulatorClass := anUnsimulatedInterpreterPluginClass subclasses + detect: [:sc| sc name endsWith: 'Simulator'] + ifNone: [anUnsimulatedInterpreterPluginClass]. ^self new + actualPlugin: simulatorClass new signatureClass: anUnsimulatedInterpreterPluginClass; - actualPlugin: anUnsimulatedInterpreterPluginClass new; yourself! Item was removed: - ----- Method: SmartSyntaxPluginSimulator>>actualPlugin: (in category 'accessing') ----- - actualPlugin: aSmartSyntaxInterpreterPlugin - actualPlugin := aSmartSyntaxInterpreterPlugin. - actualPlugin simulator: self! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>actualPlugin:signatureClass: (in category 'accessing') ----- + actualPlugin: aSmartSyntaxInterpreterPlugin signatureClass: signatureClass + pluginClass := signatureClass. + actualPlugin := aSmartSyntaxInterpreterPlugin. + actualPlugin simulator: self! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asCharPtrFrom:andThen: (in category 'simulation') ----- + ccgLoad: codeGen expr: exprBlock asCharPtrFrom: stackIndex andThen: validateBlock + ^[:oop| + validateBlock value: oop. + interpreterProxy cCoerce: (interpreterProxy firstIndexableField: oop) asInteger to: #'char *']! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asFloatValueFrom: (in category 'simulation') ----- + ccgLoad: codeGen expr: exprBlock asFloatValueFrom: stackIndex + self shouldBeImplemented! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asIntPtrFrom:andThen: (in category 'simulation') ----- + ccgLoad: codeGen expr: exprBlock asIntPtrFrom: stackIndex andThen: validateBlock + ^[:oop| + validateBlock value: oop. + interpreterProxy cCoerce: (interpreterProxy firstIndexableField: oop) asInteger to: #'int *']! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asOopPtrFrom:andThen: (in category 'simulation') ----- + ccgLoad: codeGen expr: exprBlock asOopPtrFrom: stackIndex andThen: validateBlock + ^[:oop| + validateBlock value: oop. + interpreterProxy cCoerce: (interpreterProxy firstIndexableField: oop) asInteger to: #'sqInt *']! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asUnsignedPtrFrom:andThen: (in category 'simulation') ----- + ccgLoad: codeGen expr: exprBlock asUnsignedPtrFrom: stackIndex andThen: validateBlock + ^[:oop| + validateBlock value: oop. + interpreterProxy cCoerce: (interpreterProxy firstIndexableField: oop) asInteger to: #'unsigned *']! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asUnsignedValueFrom: (in category 'simulation') ----- + ccgLoad: codeGen expr: exprBlock asUnsignedValueFrom: stackIndex + self shouldBeImplemented! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asWBFloatPtrFrom: (in category 'simulation') ----- + ccgLoad: codeGen expr: exprBlock asWBFloatPtrFrom: stackIndex + self shouldBeImplemented! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>ccgValBlock: (in category 'simulation') ----- + ccgValBlock: aString + ^aString caseOf: { + ['isBytes'] -> [ [:oop| + interpreterProxy success: (interpreterProxy isBytes: oop). + oop]]. + ['isWordsOrBytes'] -> [ [:oop| + interpreterProxy success: (interpreterProxy isWordsOrBytes: oop). + oop]] }! Item was changed: ----- Method: SmartSyntaxPluginSimulator>>computeSignatureMap (in category 'initialize') ----- computeSignatureMap forMap := true. "true only while we compute the signatureMap" signatureMap := Dictionary new. + pluginClass selectorsAndMethodsDo: - actualPlugin class selectorsAndMethodsDo: [:s :m| + (m messages includesAnyOf: #(primitive: primitive:parameters: primitive:parameters:receiver:)) - (m messages includesAnyOf: #(primitive:parameters: primitive:parameters:receiver:)) ifTrue: [self getPrimitiveSignatureFor: s] ifFalse: [(m pragmaAt: #export:) ifNotNil: [:exportPragma| (exportPragma argumentAt: 1) ifTrue: [self computeSignatureFor: s from: { #forMap. s. #(). nil }]]]]. forMap := false! Item was changed: ----- Method: SmartSyntaxPluginSimulator>>doesNotUnderstand: (in category 'message forwarding') ----- doesNotUnderstand: aMessage | signature selector parameters result | signature := signatureMap at: aMessage selector ifAbsent: [^super doesNotUnderstand: aMessage]. selector := signature first. parameters := signature second. signature third "receiver block" value: (interpreterProxy stackValue: parameters size). interpreterProxy failed ifTrue: [^nil]. result := [actualPlugin perform: selector withArguments: (parameters withIndexCollect: [:block :index| block value: (interpreterProxy stackValue: parameters size - index)])] on: Notification do: [:ex| ex tag == #getSimulator ifTrue: [ex resume: self] ifFalse: [ex pass]]. interpreterProxy failed ifTrue: [^nil]. + result == actualPlugin ifTrue: + [interpreterProxy pop: interpreterProxy methodArgumentCount. + ^nil]. interpreterProxy pop: interpreterProxy methodArgumentCount + 1 thenPush: result. ^nil "SmartSyntaxPluginPrimitives return null"! Item was added: + ----- Method: SmartSyntaxPluginSimulator>>primitive: (in category 'simulation') ----- + primitive: primNameString + "If initializing, pass back the type signature. If executing, answer nil." + ^self primitive: primNameString parameters: #() receiver: nil!

1 0

VM Maker: VMMaker.oscog-eem.2056.mcz
by commits＠source.squeak.org 29 Dec '16

29 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2056.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2056 Author: eem Time: 29 December 2016, 8:54:25.129752 am UUID: 36772c61-cd8d-48cf-addb-26a0ba374f3a Ancestors: VMMaker.oscog-eem.2055 Simulator: Fix firstIndexableField: in the Spur MM sims. Have plugins be closed whenever the VM is closed. Properly implement close to send close to any plugin that wants it. =============== Diff against VMMaker.oscog-eem.2055 =============== Item was changed: ----- Method: CogVMSimulator>>close (in category 'initialization') ----- + close "close any files that ST may have opened, etc" + pluginList do: [:plugin| (plugin ~~ self and: [plugin respondsTo: #close]) ifTrue: [plugin close]]! - close "close any files that ST may have opened" - (self loadNewPlugin: 'FilePlugin') ifNotNil: - [:filePlugin| filePlugin close]! Item was changed: ----- Method: CogVMSimulator>>initialize (in category 'initialization') ----- initialize "Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." super initialize. transcript := Transcript. objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. cogit ifNil: [cogit := self class cogitClass new setInterpreter: self]. objectMemory coInterpreter: self cogit: cogit. cogit numRegArgs > 0 ifTrue: [debugStackDepthDictionary := Dictionary new]. cogThreadManager ifNotNil: [super initialize]. self assert: ConstMinusOne = (objectMemory integerObjectOf: -1). cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())" enableCog := true. methodCache := Array new: MethodCacheSize. nsMethodCache := Array new: NSMethodCacheSize. atCache := nil. self flushMethodCache. cogCompiledCodeCompactionCalledFor := false. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. mappedPluginEntries := OrderedCollection new. objectMemory hasSpurMemoryManagerAPI ifTrue: [primitiveAccessorDepthTable := Array new: primitiveTable size. pluginList := {}. self loadNewPlugin: ''] ifFalse: [pluginList := {'' -> self }]. desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := self ioUTCStartMicroseconds. maxLiteralCountForCompile := MaxLiteralCountForCompile. minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile. flagInterpretedMethods := false. "initialize InterpreterSimulator variables used for debugging" byteCount := lastPollCount := sendCount := lookupCount := 0. + quitBlock := [^self close]. - quitBlock := [^ self]. traceOn := true. printSends := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form. eventQueue := SharedQueue new. suppressHeartbeatFlag := deferSmash := deferredSmash := false. systemAttributes := Dictionary new. primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0). primTraceLogIndex := 0. traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0). traceLogIndex := 0. traceSources := TraceSources. statCodeCompactionCount := 0. statCodeCompactionUsecs := 0. extSemTabSize := 256! Item was changed: ----- Method: CogVMSimulator>>logOfBytesVerify:fromFileNamed:fromStart: (in category 'testing') ----- logOfBytesVerify: nBytes fromFileNamed: fileName fromStart: loggingStart "Verify a questionable interpreter against a successful run" "self logOfBytesVerify: 10000 fromFileNamed: 'clone32Bytecodes.log' " | logFile rightWord prevCtxt | logFile := (FileStream readOnlyFileNamed: fileName) binary. transcript clear. byteCount := 0. + quitBlock := [^self close]. - quitBlock := [^ self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. prevCtxt := 0. prevCtxt := prevCtxt. [byteCount < nBytes] whileTrue: [ " byteCount > 14560 ifTrue: [self externalizeIPandSP. prevCtxt = activeContext ifFalse: [prevCtxt := activeContext. transcript cr; nextPutAll: (self printTop: 2); endEntry]. transcript cr; print: byteCount; nextPutAll: ': ' , (activeContext hex); space; print: (instructionPointer - method - (BaseHeaderSize - 2)); nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space; nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space; print: (self stackPointerIndex - TempFrameStart + 1); endEntry. byteCount = 14590 ifTrue: [self halt]]. " loggingStart >= byteCount ifTrue: [rightWord := logFile nextWord. currentBytecode = rightWord ifFalse: [self halt: 'halt at ', byteCount printString]]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. self externalizeIPandSP. logFile close. self inform: nBytes printString , ' bytecodes verfied.'! Item was changed: ----- Method: CogVMSimulator>>logOfBytesWrite:toFileNamed:fromStart: (in category 'testing') ----- logOfBytesWrite: nBytes toFileNamed: fileName fromStart: loggingStart "Write a log file for testing a flaky interpreter on the same image" "self logOfBytesWrite: 10000 toFileNamed: 'clone32Bytecodes.log' " | logFile | logFile := (FileStream newFileNamed: fileName) binary. transcript clear. byteCount := 0. + quitBlock := [^self close]. - quitBlock := [^ self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [byteCount < nBytes] whileTrue: [byteCount >= loggingStart ifTrue: [logFile nextWordPut: currentBytecode]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. self externalizeIPandSP. logFile close! Item was changed: ----- Method: CogVMSimulator>>logOfSendsVerify:fromFileNamed:fromStart: (in category 'testing') ----- logOfSendsVerify: nSends fromFileNamed: fileName fromStart: loggingStart "Write a log file for testing a flaky interpreter on the same image" "self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' " | logFile priorFrame rightSelector prevCtxt | logFile := FileStream readOnlyFileNamed: fileName. transcript clear. byteCount := 0. sendCount := 0. priorFrame := localFP. + quitBlock := [^self close]. - quitBlock := [^ self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. prevCtxt := 0. prevCtxt := prevCtxt. [sendCount < nSends] whileTrue: [ " byteCount>500 ifTrue: [byteCount>550 ifTrue: [self halt]. self externalizeIPandSP. prevCtxt = localFP ifFalse: [prevCtxt := localFP. transcript cr; nextPutAll: (self printTop: 2); endEntry]. transcript cr; print: byteCount; nextPutAll: ': ' , (localFP hex); space; print: (instructionPointer - method - (BaseHeaderSize - 2)); nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space; nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space; print: (self stackPointerIndex - TempFrameStart + 1); endEntry. ]. " self dispatchOn: currentBytecode in: BytecodeTable. localFP = priorFrame ifFalse: [sendCount := sendCount + 1. loggingStart >= sendCount ifTrue: [rightSelector := logFile nextLine. (self stringOf: messageSelector) = rightSelector ifFalse: [self halt: 'halt at ', sendCount printString]]. priorFrame := localFP]. self incrementByteCount]. self externalizeIPandSP. logFile close. self inform: nSends printString , ' sends verfied.'! Item was changed: ----- Method: CogVMSimulator>>logOfSendsWrite:toFileNamed:fromStart: (in category 'testing') ----- logOfSendsWrite: nSends toFileNamed: fileName fromStart: loggingStart "Write a log file for testing a flaky interpreter on the same image" "self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' fromStart: 2500" | logFile priorFrame | logFile := FileStream newFileNamed: fileName. transcript clear. byteCount := 0. sendCount := 0. priorFrame := localFP. + quitBlock := [^self close]. - quitBlock := [^ self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [sendCount < nSends] whileTrue: [self dispatchOn: currentBytecode in: BytecodeTable. localFP == priorFrame ifFalse: [sendCount >= loggingStart ifTrue: [sendCount := sendCount + 1. logFile nextPutAll: (self stringOf: messageSelector); cr]. priorFrame := localFP]. self incrementByteCount]. self externalizeIPandSP. logFile close! Item was changed: ----- Method: CogVMSimulator>>run (in category 'testing') ----- run "Just run" quitBlock := [displayView ifNotNil: [displayView containingWindow ifNotNil: [:topWindow| ((World submorphs includes: topWindow) and: [UIManager default confirm: 'close?']) ifTrue: [topWindow delete]]]. + ^self close]. - ^self]. self initStackPages. self loadInitialContext. self initialEnterSmalltalkExecutive! Item was changed: ----- Method: CogVMSimulator>>runWithBreakCount: (in category 'testing') ----- runWithBreakCount: theBreakCount "Just run, halting when byteCount is reached" quitBlock := [displayView ifNotNil: [displayView containingWindow ifNotNil: [:topWindow| ((World submorphs includes: topWindow) and: [UIManager default confirm: 'close?']) ifTrue: [topWindow delete]]]. + ^self close]. - ^self]. breakCount := theBreakCount. self initStackPages. self loadInitialContext. self initialEnterSmalltalkExecutive! Item was changed: ----- Method: CogVMSimulator>>testBreakCount:printSends:printFrames:printBytecodes: (in category 'testing') ----- testBreakCount: breakCount printSends: shouldPrintSends printFrames: shouldPrintFrames printBytecodes: shouldPrintBytecodes self initStackPages. self loadInitialContext. transcript clear. + quitBlock := [^self close]. - quitBlock := [^self]. printSends := true & shouldPrintSends. "true & foo allows evaluating printFoo := true in the debugger" printFrameAtEachStep := true & shouldPrintFrames. printBytecodeAtEachStep := true & shouldPrintBytecodes. self ensureDebugAtEachStepBlock. self initialEnterSmalltalkExecutive! Item was changed: ----- Method: Spur32BitMMLECoSimulator>>firstIndexableField: (in category 'object format') ----- firstIndexableField: objOop "NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes. There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5. The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end of the object). For 3 we must go to the class." | fmt classFormat | <returnTypeC: #'void *'> fmt := self formatOf: objOop. fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word" [(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue: [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop). ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)) to: #'oop *']. + ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize) - ^self cCoerce: (self pointerForOop: objOop - + self baseHeaderSize - + ((self numSlotsOf: objOop) << self shiftForWord)) to: #'oop *']. "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0" self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]). ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize) to: (fmt < self firstByteFormat ifTrue: [fmt = self sixtyFourBitIndexableFormat ifTrue: ["64 bit field objects" #'long long *'] ifFalse: [fmt < self firstShortFormat ifTrue: ["32 bit field objects" #'int *'] ifFalse: ["16-bit field objects" #'short *']]] ifFalse: ["byte objects (including CompiledMethod" #'char *'])! Item was changed: ----- Method: Spur32BitMMLESimulator>>firstIndexableField: (in category 'object format') ----- firstIndexableField: objOop "NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes. There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5. The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end of the object). For 3 we must go to the class." | fmt classFormat | <returnTypeC: #'void *'> fmt := self formatOf: objOop. fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word" [(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue: [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop). ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)) to: #'oop *']. + ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize) - ^self cCoerce: (self pointerForOop: objOop - + self baseHeaderSize - + ((self numSlotsOf: objOop) << self shiftForWord)) to: #'oop *']. "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0" self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]). ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize) to: (fmt < self firstByteFormat ifTrue: [fmt = self sixtyFourBitIndexableFormat ifTrue: ["64 bit field objects" #'long long *'] ifFalse: [fmt < self firstShortFormat ifTrue: ["32 bit field objects" #'int *'] ifFalse: ["16-bit field objects" #'short *']]] ifFalse: ["byte objects (including CompiledMethod" #'char *'])! Item was changed: ----- Method: Spur64BitMMLECoSimulator>>firstIndexableField: (in category 'object format') ----- firstIndexableField: objOop "NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes. There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5. The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end of the object). For 3 we must go to the class." | fmt classFormat | <returnTypeC: #'void *'> fmt := self formatOf: objOop. fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word" [(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue: [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop). ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)) to: #'oop *']. + ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize) - ^self cCoerce: (self pointerForOop: objOop - + self baseHeaderSize - + ((self numSlotsOf: objOop) << self shiftForWord)) to: #'oop *']. "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0" self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]). ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize) to: (fmt < self firstByteFormat ifTrue: [fmt = self sixtyFourBitIndexableFormat ifTrue: ["64 bit field objects" #'long long *'] ifFalse: [fmt < self firstShortFormat ifTrue: ["32 bit field objects" #'int *'] ifFalse: ["16-bit field objects" #'short *']]] ifFalse: ["byte objects (including CompiledMethod" #'char *'])! Item was changed: ----- Method: Spur64BitMMLESimulator>>firstIndexableField: (in category 'object format') ----- firstIndexableField: objOop "NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes. There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5. The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end of the object). For 3 we must go to the class." | fmt classFormat | <returnTypeC: #'void *'> fmt := self formatOf: objOop. fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word" [(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue: [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop). ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)) to: #'oop *']. + ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize) - ^self cCoerce: (self pointerForOop: objOop - + self baseHeaderSize - + ((self numSlotsOf: objOop) << self shiftForWord)) to: #'oop *']. "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0" self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]). ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize) to: (fmt < self firstByteFormat ifTrue: [fmt = self sixtyFourBitIndexableFormat ifTrue: ["64 bit field objects" #'long long *'] ifFalse: [fmt < self firstShortFormat ifTrue: ["32 bit field objects" #'int *'] ifFalse: ["16-bit field objects" #'short *']]] ifFalse: ["byte objects (including CompiledMethod" #'char *'])! Item was changed: ----- Method: StackInterpreterSimulator>>close (in category 'initialization') ----- + close "close any files that ST may have opened, etc" + pluginList do: [:plugin| (plugin ~~ self and: [plugin respondsTo: #close]) ifTrue: [plugin close]]! - close "close any files that ST may have opened" - (self loadNewPlugin: 'FilePlugin') ifNotNil: - [:filePlugin| filePlugin close]! Item was changed: ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') ----- initialize "Initialize the StackInterpreterSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." super initialize. bootstrapping := false. transcript := Transcript. objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. objectMemory coInterpreter: self. self assert: ConstMinusOne = (objectMemory integerObjectOf: -1). methodCache := Array new: MethodCacheSize. nsMethodCache := Array new: NSMethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. mappedPluginEntries := OrderedCollection new. objectMemory hasSpurMemoryManagerAPI ifTrue: [primitiveAccessorDepthTable := Array new: primitiveTable size. pluginList := {}. self loadNewPlugin: ''] ifFalse: [pluginList := {'' -> self }]. desiredNumStackPages := desiredEdenBytes := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := self ioUTCStartMicroseconds. "initialize InterpreterSimulator variables used for debugging" byteCount := sendCount := lookupCount := 0. + quitBlock := [^self close]. - quitBlock := [^self]. traceOn := true. printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form. eventQueue := SharedQueue new. suppressHeartbeatFlag := false. systemAttributes := Dictionary new. extSemTabSize := 256. disableBooleanCheat := false. assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"! Item was changed: ----- Method: StackInterpreterSimulator>>logOfBytesVerify:fromFileNamed:fromStart: (in category 'testing') ----- logOfBytesVerify: nBytes fromFileNamed: fileName fromStart: loggingStart "Verify a questionable interpreter against a successful run" "self logOfBytesVerify: 10000 fromFileNamed: 'clone32Bytecodes.log' " | logFile rightWord prevCtxt | logFile := (FileStream readOnlyFileNamed: fileName) binary. transcript clear. byteCount := 0. + quitBlock := [^self close]. - quitBlock := [^ self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. prevCtxt := 0. prevCtxt := prevCtxt. [byteCount < nBytes] whileTrue: [ " byteCount > 14560 ifTrue: [self externalizeIPandSP. prevCtxt = activeContext ifFalse: [prevCtxt := activeContext. transcript cr; nextPutAll: (self printTop: 2); endEntry]. transcript cr; print: byteCount; nextPutAll: ': ' , (activeContext hex); space; print: (instructionPointer - method - (BaseHeaderSize - 2)); nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space; nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space; print: (self stackPointerIndex - TempFrameStart + 1); endEntry. byteCount = 14590 ifTrue: [self halt]]. " loggingStart >= byteCount ifTrue: [rightWord := logFile nextWord. currentBytecode = rightWord ifFalse: [self halt: 'halt at ', byteCount printString]]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. self externalizeIPandSP. logFile close. self inform: nBytes printString , ' bytecodes verfied.'! Item was changed: ----- Method: StackInterpreterSimulator>>logOfBytesWrite:toFileNamed:fromStart: (in category 'testing') ----- logOfBytesWrite: nBytes toFileNamed: fileName fromStart: loggingStart "Write a log file for testing a flaky interpreter on the same image" "self logOfBytesWrite: 10000 toFileNamed: 'clone32Bytecodes.log' " | logFile | logFile := (FileStream newFileNamed: fileName) binary. transcript clear. byteCount := 0. + quitBlock := [^self close]. - quitBlock := [^ self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [byteCount < nBytes] whileTrue: [byteCount >= loggingStart ifTrue: [logFile nextWordPut: currentBytecode]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. self externalizeIPandSP. logFile close! Item was changed: ----- Method: StackInterpreterSimulator>>logOfSendsVerify:fromFileNamed:fromStart: (in category 'testing') ----- logOfSendsVerify: nSends fromFileNamed: fileName fromStart: loggingStart "Write a log file for testing a flaky interpreter on the same image" "self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' " | logFile priorFrame rightSelector prevCtxt | logFile := FileStream readOnlyFileNamed: fileName. transcript clear. byteCount := 0. sendCount := 0. priorFrame := localFP. + quitBlock := [^self close]. - quitBlock := [^ self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. prevCtxt := 0. prevCtxt := prevCtxt. [sendCount < nSends] whileTrue: [ " byteCount>500 ifTrue: [byteCount>550 ifTrue: [self halt]. self externalizeIPandSP. prevCtxt = localFP ifFalse: [prevCtxt := localFP. transcript cr; nextPutAll: (self printTop: 2); endEntry]. transcript cr; print: byteCount; nextPutAll: ': ' , (localFP hex); space; print: (instructionPointer - method - (BaseHeaderSize - 2)); nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space; nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space; print: (self stackPointerIndex - TempFrameStart + 1); endEntry. ]. " self dispatchOn: currentBytecode in: BytecodeTable. localFP = priorFrame ifFalse: [sendCount := sendCount + 1. loggingStart >= sendCount ifTrue: [rightSelector := logFile nextLine. (self stringOf: messageSelector) = rightSelector ifFalse: [self halt: 'halt at ', sendCount printString]]. priorFrame := localFP]. self incrementByteCount]. self externalizeIPandSP. logFile close. self inform: nSends printString , ' sends verfied.'! Item was changed: ----- Method: StackInterpreterSimulator>>logOfSendsWrite:toFileNamed:fromStart: (in category 'testing') ----- logOfSendsWrite: nSends toFileNamed: fileName fromStart: loggingStart "Write a log file for testing a flaky interpreter on the same image" "self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' " | logFile priorFrame | logFile := FileStream newFileNamed: fileName. transcript clear. byteCount := 0. sendCount := 0. priorFrame := localFP. + quitBlock := [^self close]. - quitBlock := [^ self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [sendCount < nSends] whileTrue: [self dispatchOn: currentBytecode in: BytecodeTable. localFP = priorFrame ifFalse: [sendCount >= loggingStart ifTrue: [sendCount := sendCount + 1. logFile nextPutAll: (self stringOf: messageSelector); cr]. priorFrame := localFP]. self incrementByteCount]. self externalizeIPandSP. logFile close! Item was changed: ----- Method: StackInterpreterSimulator>>run (in category 'testing') ----- run "Just run" quitBlock := [displayView ifNotNil: [displayView containingWindow ifNotNil: [:topWindow| ((World submorphs includes: topWindow) and: [UIManager default confirm: 'close?']) ifTrue: [topWindow delete]]]. + ^self close]. - ^self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. atEachStepBlock value. "N.B. may be nil" self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. localIP := localIP - 1. "undo the pre-increment of IP before returning" self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') ----- runWithBreakCount: theBreakCount "Just run, halting when byteCount is reached" quitBlock := [displayView ifNotNil: [displayView containingWindow ifNotNil: [:topWindow| ((World submorphs includes: topWindow) and: [UIManager default confirm: 'close?']) ifTrue: [topWindow delete]]]. + ^self close]. - ^self]. breakCount := theBreakCount. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. localIP := localIP - 1. "undo the pre-increment of IP before returning" self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>test (in category 'testing') ----- test self initStackPages. self loadInitialContext. transcript clear. byteCount := 0. breakCount := -1. + quitBlock := [^self close]. - quitBlock := [^self]. printSends := printReturns := true. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. printFrameAtEachStep ifTrue: [self printFrame: localFP WithSP: localSP]. printBytecodeAtEachStep ifTrue: [self printCurrentBytecodeOn: Transcript. Transcript cr; flush]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount. byteCount = breakCount ifTrue: ["printFrameAtEachStep :=" printBytecodeAtEachStep := true. self halt: 'hit breakCount break-point']]. self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>test1 (in category 'testing') ----- test1 self initStackPages. self loadInitialContext. transcript clear. byteCount := 0. breakCount := -1. self setBreakSelector: #blockCopy:. + quitBlock := [^self close]. - quitBlock := [^self]. printSends := printReturns := true. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. "byteCount >= 22283 ifTrue: [(self checkIsStillMarriedContext: 22186072 currentFP: localFP) ifFalse: [self halt]]." (printBytecodeAtEachStep "and: [self isMarriedOrWidowedContext: 22189568]") ifTrue: ["| thePage | thePage := stackPages stackPageFor: (self frameOfMarriedContext: 22189568). thePage == stackPage ifTrue: [self shortPrintFrameAndCallers: localFP SP: localSP] ifFalse: [self shortPrintFrameAndCallers: thePage headFrameFP SP: thePage headFrameSP]." self printCurrentBytecodeOn: Transcript. Transcript cr; flush]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount. byteCount = breakCount ifTrue: ["printFrameAtEachStep := true." printSends := printBytecodeAtEachStep := true. self halt: 'hit breakCount break-point']]. self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>testBreakCount:printSends:printFrames:printBytecodes: (in category 'testing') ----- testBreakCount: breakCount printSends: shouldPrintSends printFrames: shouldPrintFrames printBytecodes: shouldPrintBytecodes self initStackPages. self loadInitialContext. transcript clear. byteCount := 0. + quitBlock := [^self close]. - quitBlock := [^self]. printSends := true & shouldPrintSends. "true & foo allows evaluating printFoo := true in the debugger" printFrameAtEachStep := true & shouldPrintFrames. printBytecodeAtEachStep := true & shouldPrintBytecodes. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. printFrameAtEachStep ifTrue: [self printFrame: localFP WithSP: localSP]. printBytecodeAtEachStep ifTrue: [self printCurrentBytecodeOn: Transcript. Transcript cr; flush]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount. byteCount = breakCount ifTrue: ["printFrameAtEachStep :=" printBytecodeAtEachStep := true. self halt: 'hit breakCount break-point']]. self externalizeIPandSP!

1 0

Debugging the new compactor and the SocketPlugin ;-)
by Eliot Miranda 29 Dec '16

29 Dec '16

Hi All, I'm having a blast writing and debugging the new compactor. I've got to the stage where, in a real VM, I can load and save images and run global garbage collect fairly reliably, but when I go through a sequence of check changes on a package in the Monticello Browser attempt to save these changes receive warning that there's a more up-to-date version update the image I reliably get a crash. Now in the simulator I'm using lemming debugging to be able to endlessly repeat a failing GC, with the original heap unchanged as a reference, hence having a blast, cuz this makes it relatively easy to debug. But in the real VM I would have to implement a fair ammount to reproduce lemming debugging - forking the process on GC - running the GC in the child - catching the exit status - raising an exception in the parent to allow the debugger to attach - being able to proceed from the exception by repeating the fork and the GC, etc... And yet if and when I did this I would still have nothing like the debuggability I have in the simulator. To be able to reproduce the original sequent in the Simulator I also need a fair amount, to be specific, I need a simulate able SocketPlugin. This means implementing some subset of #sqResolverAbort #sqResolverAddrLookup:Result: #sqResolverAddrLookupResultSize #sqResolverError #sqResolverGetAddressInfoFamily #sqResolverGetAddressInfoHost:Size:Service:Size:Flags:Family:Type:Protocol: #sqResolverGetAddressInfoNext #sqResolverGetAddressInfoProtocol #sqResolverGetAddressInfoResult:Size: #sqResolverGetAddressInfoSize #sqResolverGetAddressInfoType #sqResolverGetNameInfo:Size:Flags: #sqResolverGetNameInfoHostResult:Size: #sqResolverGetNameInfoHostSize #sqResolverGetNameInfoServiceResult:Size: #sqResolverGetNameInfoServiceSize #sqResolverHostNameResult:Size: #sqResolverHostNameSize #sqResolverLocalAddress #sqResolverNameLookupResult #sqResolverStartAddrLookup: #sqResolverStartName:Lookup: #sqResolverStatus #sqSocket:AcceptFrom:RecvBytes:SendBytes:SemaID: #sqSocket:AcceptFrom:RecvBytes:SendBytes:SemaID:ReadSemaID:WriteSemaID: #sqSocket:BindTo:Port: #sqSocket:BindToAddress:Size: #sqSocket:ConnectTo:Port: #sqSocket:ConnectToAddress:Size: #sqSocket:CreateNetType:SocketType:RecvBytes:SendBytes:SemaID: #sqSocket:CreateNetType:SocketType:RecvBytes:SendBytes:SemaID:ReadSemaID:WriteSemaID: #sqSocket:CreateRaw:ProtoType:RecvBytes:SendBytes:SemaID:ReadSemaID:WriteSemaID: #sqSocket:ListenBacklog: #sqSocket:ListenOnPort: #sqSocket:ListenOnPort:BacklogSize: #sqSocket:ListenOnPort:BacklogSize:Interface: #sqSocket:LocalAddressResult:Size: #sqSocket:ReceiveDataBuf:Count: #sqSocket:ReceiveUDPDataBuf:Count:address:port:moreFlag: #sqSocket:RemoteAddressResult:Size: #sqSocket:SendDataBuf:Count: #sqSocket:toHost:port:SendDataBuf:Count: #sqSocketAbortConnection: #sqSocketAddress:Size:SetPort: #sqSocketAddress:SizeGetPort: #sqSocketCloseConnection: #sqSocketConnectionStatus: #sqSocketDestroy: #sqSocketError: #sqSocketGetOptions:optionNameStart:optionNameSize:returnedValue: #sqSocketLocalAddress: #sqSocketLocalAddressSize: #sqSocketLocalPort: #sqSocketReceiveDataAvailable: #sqSocketRemoteAddress: #sqSocketRemoteAddressSize: #sqSocketRemotePort: #sqSocketSendDone: #sqSocketSetOptions:optionNameStart:optionNameSize:optionValueStart:optionValueSize:returnedValue: ;-) (BTW, the implementation strategy, as it is with the FilePluginSmulator, is to fall back on the host image's facilities; probably simpler with the SocketPlugin than the FilePlugin because there's no need to fake up directory entries and the like - at least I hope so). Now being able to simulate images that use sockets is probably quite useful. And I'm leaning toads having a go, but have no idea how long its going to take (I don't know the subset of the above that will need to be implemented to get image update to simulate fully). So has anyone else had any experience here? Got a SocketPluginSimulator you've hidden away for a rainy day? Think its way too difficult and I should implement lemming debugging for real? _,,,^..^,,,_ best, Eliot

3 4

VM Maker: VMMaker.oscog-eem.2055.mcz
by commits＠source.squeak.org 28 Dec '16

28 Dec '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2055.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2055 Author: eem Time: 28 December 2016, 2:07:51.943529 pm UUID: 5c451a9e-3c33-4788-9e7b-37f3156e6b27 Ancestors: VMMaker.oscog-eem.2054 SpurPlanningCompactor: Continue correctly in the update and copyAndUnmark phases by adding a top parameter to hold the initial and/or continuing value of top. Refactor updatePointersIn:startingAt:savedFirstFieldPointer: into two separate updatePointersIn: & updatePointersIn:savedFirstFieldPointer: methods, and move updating the savedFirstField into updatePointersIn:savedFirstFieldPointer:. Log the phases. General: Fix a C compiler warning. Sim: Delete an unused method. =============== Diff against VMMaker.oscog-eem.2054 =============== Item was changed: ----- Method: CoInterpreter>>ceSendMustBeBooleanTo:interpretingAtDelta: (in category 'trampolines') ----- ceSendMustBeBooleanTo: aNonBooleanObject interpretingAtDelta: jumpSize "For RegisterAllocatingCogit we want the address following a conditional branch not to be reachable, so we don't have to generate code to reload registers. Instead simply convert to an interpreter frame, backup the pc to the branch, reenter the interpreter and hence retry the mustBeBoolean send therein." <api> | cogMethod methodObj methodHeader startBcpc | <var: 'cogMethod' type: #'CogBlockMethod *'> + <var: 'p' type: #'char *'> self assert: (objectMemory addressCouldBeOop: aNonBooleanObject). cogMethod := self mframeCogMethod: framePointer. ((self mframeIsBlockActivation: framePointer) and: [cogMethod cmIsFullBlock not]) ifTrue: [methodHeader := (self cCoerceSimple: cogMethod cmHomeMethod to: #'CogMethod *') methodHeader. methodObj := (self cCoerceSimple: cogMethod cmHomeMethod to: #'CogMethod *') methodObject. startBcpc := cogMethod startpc] ifFalse: [methodHeader := (self cCoerceSimple: cogMethod to: #'CogMethod *') methodHeader. methodObj := (self cCoerceSimple: cogMethod to: #'CogMethod *') methodObject. startBcpc := self startPCOfMethod: methodObj]. "Map the machine code instructionPointer to the interpreter instructionPointer of the branch." instructionPointer := self popStack. instructionPointer := cogit bytecodePCFor: instructionPointer startBcpc: startBcpc in: cogMethod. instructionPointer := methodObj + objectMemory baseHeaderSize + instructionPointer - jumpSize - 1. "pre-decrement" "Make space for the two extra fields in an interpreter frame" stackPointer to: framePointer + FoxMFReceiver by: objectMemory wordSize do: [:p| | oop | oop := objectMemory longAt: p. objectMemory longAt: p - objectMemory wordSize - objectMemory wordSize put: (objectMemory longAt: p)]. stackPointer := stackPointer - objectMemory wordSize - objectMemory wordSize. self push: aNonBooleanObject. "Fill in the fields" objectMemory longAt: framePointer + FoxIFrameFlags put: (self encodeFrameFieldHasContext: (self mframeHasContext: framePointer) isBlock: (self mframeIsBlockActivation: framePointer) numArgs: cogMethod cmNumArgs); longAt: framePointer + FoxIFSavedIP put: 0; longAt: framePointer + FoxMethod put: methodObj. "and now reenter the interpreter..." self setMethod: methodObj methodHeader: methodHeader. self siglong: reenterInterpreter jmp: ReturnToInterpreter.! Item was removed: - ----- Method: FilePluginSimulator>>primitiveFileRename (in category 'simulation') ----- - primitiveFileRename - ^interpreterProxy primitiveFileRename! Item was changed: ----- Method: SpurMemoryManager>>formatFieldWidthShift (in category 'header format') ----- formatFieldWidthShift + <cmacro> "The format field contains 5 bits." ^5! Item was changed: ----- Method: SpurMemoryManager>>greyBitShift (in category 'header format') ----- greyBitShift + <cmacro> "bit 2 of 3-bit field above format (little endian)" ^31! Item was changed: ----- Method: SpurMemoryManager>>immutableBitShift (in category 'header format') ----- immutableBitShift + <cmacro> "bit 1 of 2-bit field above classIndex (little endian)" ^23! Item was changed: ----- Method: SpurMemoryManager>>markedBitFullShift (in category 'header format') ----- markedBitFullShift + <cmacro> "bit 1 of 2-bit field above identityHash (little endian)" ^55! Item was changed: ----- Method: SpurMemoryManager>>markedBitHalfShift (in category 'header format') ----- markedBitHalfShift + <cmacro> "bit 1 of 2-bit field above identityHash (little endian)" ^23! Item was changed: ----- Method: SpurMemoryManager>>pinnedBitShift (in category 'header format') ----- pinnedBitShift + <cmacro> "bit 1 of 3-bit field above format (little endian)" ^30! Item was changed: ----- Method: SpurMemoryManager>>printEntity: (in category 'debug printing') ----- printEntity: oop + <api> + coInterpreter printHex: oop; space. + (self addressCouldBeObj: oop) ifFalse: + [^coInterpreter print: ((self isImmediate: oop) ifTrue: ['immediate'] ifFalse: ['unknown'])]. coInterpreter - printHex: oop; print: '/'; printNum: oop; space; print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse: [(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse: [(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse: + [(self classIndexOf: oop) <= self lastClassIndexPun ifTrue: ['pun/obj stack'] ifFalse: + ['object']]]]); - ['object']]]); space; printHex: (self bytesInObject: oop); print: '/'; printNum: (self bytesInObject: oop); cr! Item was removed: - ----- Method: SpurPlanningCompactor>>continueCopyAndUnmarkMobileObjectsFrom: (in category 'compaction') ----- - continueCopyAndUnmarkMobileObjectsFrom: anUnpinnedEntity - "copyAndUnmarkMobileObjects has encountered a run of pinned objects around which - it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a - new firstFreeObject, resetting it before continuing. - Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." - | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | - self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). - self deny: (manager isPinned: anUnpinnedEntity). - savedFirstFreeObject := firstFreeObject. - savedFirstMobileObject := firstMobileObject. - nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. - firstMobileObject := savedFirstMobileObject. - nextFreeObject ifNil: - [^true]. - firstFreeObject := nextFreeObject. - result := self copyAndUnmarkMobileObjects. - firstFreeObject := savedFirstFreeObject. - ^result! Item was added: + ----- Method: SpurPlanningCompactor>>continueCopyAndUnmarkMobileObjectsFrom:withTop: (in category 'compaction') ----- + continueCopyAndUnmarkMobileObjectsFrom: anUnpinnedEntity withTop: top + "copyAndUnmarkMobileObjects has encountered a run of pinned objects around which + it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a + new firstFreeObject, resetting it before continuing. + Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | + self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). + self deny: (manager isPinned: anUnpinnedEntity). + savedFirstFreeObject := firstFreeObject. + savedFirstMobileObject := firstMobileObject. + nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + firstMobileObject := savedFirstMobileObject. + nextFreeObject ifNil: + [^true]. + firstFreeObject := nextFreeObject. + result := self copyAndUnmarkMobileObjectsWithTop: top. + firstFreeObject := savedFirstFreeObject. + ^result! Item was removed: - ----- Method: SpurPlanningCompactor>>continueUpdatePointersInMobileObjectsFrom: (in category 'compaction') ----- - continueUpdatePointersInMobileObjectsFrom: anUnpinnedEntity - "updatePointersInMobileObjects has encountered a run of pinned objects around which - planCompactSavingForwarders cannot compact, but savedFirstFieldsSpace is still not full. - Continue the pass with a new firstFreeObject , resetting it before continuing. - Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." - | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | - self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). - self deny: (manager isPinned: anUnpinnedEntity). - savedFirstFreeObject := firstFreeObject. - savedFirstMobileObject := firstMobileObject. - nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. - firstMobileObject := savedFirstMobileObject. - nextFreeObject ifNil: - [^true]. - firstFreeObject := nextFreeObject. - result := self updatePointersInMobileObjects. - firstFreeObject := savedFirstFreeObject. - ^result! Item was added: + ----- Method: SpurPlanningCompactor>>continueUpdatePointersInMobileObjectsFrom:withTop: (in category 'compaction') ----- + continueUpdatePointersInMobileObjectsFrom: anUnpinnedEntity withTop: top + "updatePointersInMobileObjects has encountered a run of pinned objects around which + planCompactSavingForwarders cannot compact, but savedFirstFieldsSpace is still not full. + Continue the pass with a new firstFreeObject , resetting it before continuing. + Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + | result savedFirstFreeObject savedFirstMobileObject nextFreeObject | + self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). + self deny: (manager isPinned: anUnpinnedEntity). + savedFirstFreeObject := firstFreeObject. + savedFirstMobileObject := firstMobileObject. + nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. + firstMobileObject := savedFirstMobileObject. + nextFreeObject ifNil: + [^true]. + firstFreeObject := nextFreeObject. + result := self updatePointersInMobileObjectsWithTop: top. + firstFreeObject := savedFirstFreeObject. + ^result! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmark (in category 'compaction') ----- copyAndUnmark "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions, restoring their savedFirstFields." | onePass | + self logPhase: 'copying and unmarking...'. self unmarkInitialImmobileObjects. "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass." savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [self assert: firstMobileObject >= manager endOfMemory. ^self]. + onePass := self copyAndUnmarkMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop. - onePass := self copyAndUnmarkMobileObjects. onePass ifFalse: [self unmarkObjectsOverflowingSavedFirstFieldsSpace]! Item was removed: - ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') ----- - copyAndUnmarkMobileObjects - "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. - Remember to update the savedFirstFields of pointer objects, as these have been forwarded. - This enumeration matches that in planCompactSavingForwarders and updatePointersInMobileObjects." - - | toFinger top previousPin | - toFinger := manager startOfObject: firstFreeObject. - top := savedFirstFieldsSpace start - manager bytesPerOop. - self deny: (manager isMarked: firstFreeObject). - manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do: - [:o| - self assert: (previousPin isNil or: [toFinger < previousPin]). - (manager isMarked: o) ifTrue: - [(manager isPinned: o) - ifTrue: - [(manager isSegmentBridge: o) ifFalse: - [manager setIsMarkedOf: o to: false. - manager segmentManager notePinned: o]. - previousPin ifNotNil: - [self assert: previousPin > toFinger. - ((manager isSegmentBridge: previousPin) - and: [manager isSegmentBridge: o]) ifTrue: - [self halt: 'empty segment']]. - previousPin := o] - ifFalse: - [| availableSpace bytes next | - (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: - [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin. - ^false]. - [previousPin notNil - and: [availableSpace := (manager startOfObject: previousPin) - toFinger. - bytes := manager bytesInObject: o. - bytes ~= availableSpace - and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: - ["The object does not fit in the space between toFinger and previousPin. - Move toFinger beyond previousPin and update previousPin appropriately." - availableSpace > 0 ifTrue: - [manager addFreeChunkWithBytes: availableSpace at: toFinger]. - toFinger := manager addressAfter: previousPin. - self assert: toFinger < manager endOfMemory. - next := manager objectStartingAt: toFinger. - next >= o ifTrue: - [^self continueCopyAndUnmarkMobileObjectsFrom: next]. - previousPin := (manager isPinned: next) ifTrue: [next]]. - bytes := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top). - toFinger := toFinger + bytes]]]. - self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. - ^true! Item was added: + ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjectsWithTop: (in category 'compaction') ----- + copyAndUnmarkMobileObjectsWithTop: initialTop + "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. + Remember to update the savedFirstFields of pointer objects, as these have been forwarded. + This enumeration matches those in planCompactSavingForwarders and updatePointersInMobileObjects." + + | toFinger top previousPin | + toFinger := manager startOfObject: firstFreeObject. + top := initialTop. + self deny: (manager isMarked: firstFreeObject). + manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do: + [:o| | availableSpace | + self assert: (previousPin isNil or: [toFinger < previousPin]). + (manager isMarked: o) ifTrue: + [(manager isPinned: o) + ifTrue: + [(manager isSegmentBridge: o) ifFalse: + [manager setIsMarkedOf: o to: false. + manager segmentManager notePinned: o]. + previousPin ifNotNil: + [| limit | + limit := manager startOfObject: previousPin. + manager addFreeChunkWithBytes: limit - toFinger at: toFinger. + toFinger := manager addressAfter: previousPin. + self assert: toFinger < (manager startOfObject: o)]. + previousPin := o] + ifFalse: + [| bytes next | + (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin. + ^false]. + [previousPin notNil + and: [availableSpace := (manager startOfObject: previousPin) - toFinger. + bytes := manager bytesInObject: o. + bytes ~= availableSpace + and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: + ["The object does not fit in the space between toFinger and previousPin. + Move toFinger beyond previousPin and update previousPin appropriately." + availableSpace > 0 ifTrue: + [manager addFreeChunkWithBytes: availableSpace at: toFinger]. + toFinger := manager addressAfter: previousPin. + next := manager objectStartingAt: toFinger. + next >= o ifTrue: + [^self continueCopyAndUnmarkMobileObjectsFrom: next withTop: top]. + previousPin := (manager isPinned: next) ifTrue: [next]]. + bytes := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top). + toFinger := toFinger + bytes]]]. + self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. + ^true! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkObject:to:firstField: (in category 'compaction') ----- copyAndUnmarkObject: o to: toFinger firstField: firstField "Copy the object to toFinger, clearing its mark bit and restoring its firstField, which was overwritten with a forwarding pointer. Answer the number of bytes in the object, including overflow header." <inline: true> | bytes numSlots destObj start | numSlots := manager rawNumSlotsOf: o. + destObj := (manager objectWithRawSlotsHasOverflowHeader: numSlots) - destObj := (manager objectWithRawSlotsHasOverflowHeader: numSlots) ifTrue: [toFinger + manager baseHeaderSize] ifFalse: [toFinger]. + bytes := manager bytesInObject: o given: numSlots. + start := manager startOfObject: o given: numSlots. + manager - bytes := manager bytesInObject: o given: numSlots. - start := manager startOfObject: o given: numSlots. - manager mem: toFinger asVoidPointer cp: start asVoidPointer y: bytes; setIsMarkedOf: destObj to: false; storePointerUnchecked: 0 ofObject: destObj withValue: firstField. ^bytes! Item was added: + ----- Method: SpurPlanningCompactor>>logPhase: (in category 'private') ----- + logPhase: phaseName + <inline: true> + self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: phaseName; flush].! Item was added: + ----- Method: SpurPlanningCompactor>>numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: (in category 'private') ----- + numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtrOrNil + "This is a version of SpurMemoryManager>>numPointerSlotsOf: that deals with the + possibility of obj being a CompiledMethod whose header is in savedFirstFieldsSpace. + Answer the number of pointer fields in the given object. + Works with CompiledMethods, as well as ordinary objects." + <inline: true> + | contextSize numLiterals header | + fmt <= manager lastPointerFormat ifTrue: + [(fmt = manager indexablePointersFormat + and: [manager isContextNonImm: obj]) ifTrue: + ["contexts end at the stack pointer" + contextSize := coInterpreter fetchStackPointerOf: obj. + ^CtxtTempFrameStart + contextSize]. + ^manager numSlotsOf: obj "all pointers"]. + self deny: fmt = manager forwardedFormat. + fmt < manager firstCompiledMethodFormat ifTrue: [^0]. "no pointers" + + "CompiledMethod: contains both pointers and bytes" + self assert: firstFieldPtrOrNil notNil == (self isMobile: obj). + header := firstFieldPtrOrNil + ifNil: [manager methodHeaderOf: obj] + ifNotNil: [manager methodHeaderFromSavedFirstField: (manager longAt: firstFieldPtrOrNil)]. + numLiterals := manager literalCountOfMethodHeader: header. + ^numLiterals + LiteralStart! Item was changed: ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- planCompactSavingForwarders "Sweep the heap from firstFreeObject forwarding marked objects to where they can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). Note that this method is potentially recursive. If skipping a run of pinned objects causes the the algorithm to encounter another run of immobile objects it will recurse via continuePlanCompactSavingForwardersFrom:. + This enumeration matches those in updatePointersInMobileObjects and copyAndUnmarkMobileObjects." - This enumeration matches that in updatePointersInMobileObjects and copyAndUnmarkMobileObjects." | toFinger top previousPin | + savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: + [self logPhase: 'planning...']. toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace top. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self assert: (previousPin isNil or: [toFinger < previousPin]). (manager isMarked: o) ifTrue: [(manager isPinned: o) + ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." - ifTrue: [previousPin ifNotNil: + [self assert: (manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2). + toFinger := manager addressAfter: previousPin. + self assert: toFinger < (manager startOfObject: o)]. - [self assert: previousPin > toFinger. - ((manager isSegmentBridge: previousPin) - and: [manager isSegmentBridge: o]) ifTrue: - [self halt: 'empty segment']]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [savedFirstFieldsSpace top: top. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. next >= o ifTrue: [savedFirstFieldsSpace top: top. ^self continuePlanCompactSavingForwardersFrom: next]. previousPin := (manager isPinned: next) ifTrue: [next]]. lastMobileObject := o. manager longAt: top put: (manager fetchPointer: 0 ofObject: o); storePointerUnchecked: 0 "Don't use forward:to:; we dont want to alter the object in any way other than by setting the forwarding pointer" ofObject: o withValue: ((manager hasOverflowHeader: o) ifTrue: [toFinger + manager baseHeaderSize] ifFalse: [toFinger]). toFinger := toFinger + (manager bytesInObject: o)]]]. savedFirstFieldsSpace top: top. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointers (in category 'compaction') ----- updatePointers "Sweep the heap, updating all objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded." | onePass | + self logPhase: 'updating pointers...'. "If savedFirstFieldsSpace is empty there is nothing to do." savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [^self]. coInterpreter mapInterpreterOops. self updatePointersInManagerHeapEntities. self updatePointersInSurvivingObjects. self updatePointersInInitialImmobileObjects. + onePass := self updatePointersInMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop. - onePass := self updatePointersInMobileObjects. onePass ifFalse: [self updatePointersInObjectsOverflowingSavedFirstFieldsSpace]! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersIn: (in category 'compaction') ----- + updatePointersIn: obj + "Sweep the pointer fields in obj, updating all references to mobile objects to their eventual locations." + <inline: true> + | numPointerSlots | + numPointerSlots := manager numPointerSlotsOf: obj. + 0 to: numPointerSlots - 1 do: + [:i| | oop fwd | + oop := manager fetchPointer: i ofObject: obj. + ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: + [self assert: ((manager isMarked: oop) or: [obj = manager hiddenRootsObject]). + fwd := manager fetchPointer: 0 ofObject: oop. + self assert: (self isPostMobile: fwd). + manager storePointerUnchecked: i ofObject: obj withValue: fwd]]! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersIn:savedFirstFieldPointer: (in category 'compaction') ----- + updatePointersIn: obj savedFirstFieldPointer: firstFieldPtrOrNil + "Sweep the pointer fields in obj, updating all references to mobile objects to their eventual locations. + firstFieldPtrOrNil is supplied for mobile objects so that the saved first field can be updated, and so that + the first field of a compiled method (which is its header, or reference to a CogMethod holding its header) + can be retrieved." + <inline: false> + | fmt numPointerSlots | + fmt := manager formatOf: obj. + numPointerSlots := self numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtrOrNil. + (fmt <= manager lastPointerFormat "excludes CompiledMethod" + and: [numPointerSlots > 0]) ifTrue: + [| oop fwd | + "Relocate the saved first field; Note that CompiledMethods can be excluded since their + first field is either a SmallInteger or a reference to a CogMethod outside of oldSpace." + oop := manager longAt: firstFieldPtrOrNil. + ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: + [self assert: (manager isMarked: oop). + fwd := manager fetchPointer: 0 ofObject: oop. + self assert: (self isPostMobile: fwd). + manager longAt: firstFieldPtrOrNil put: fwd]]. + 1 to: numPointerSlots - 1 do: + [:i| | oop fwd | + oop := manager fetchPointer: i ofObject: obj. + ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: + [self assert: ((manager isMarked: oop) or: [obj = manager hiddenRootsObject]). + fwd := manager fetchPointer: 0 ofObject: oop. + self assert: (self isPostMobile: fwd). + manager storePointerUnchecked: i ofObject: obj withValue: fwd]]! Item was removed: - ----- Method: SpurPlanningCompactor>>updatePointersIn:startingAt:savedFirstFieldPointer: (in category 'compaction') ----- - updatePointersIn: obj startingAt: startIndex savedFirstFieldPointer: firstFieldPtrOrNil - "Sweep the pointer fields in obj, updating all references to mobile objects to their eventual locations. - firstFieldPtrOrNil is supplied for mobile objects so that the first field of a compiled method (which is - its header, or reference to a CogMethod holding its header) can be retrieved." - <inline: true> - startIndex to: (self numPointerSlotsWhileCompactingOf: obj savedFirstFieldPointer: firstFieldPtrOrNil) - 1 do: - [:i| | oop fwd | - oop := manager fetchPointer: i ofObject: obj. - ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: - [self assert: ((manager isMarked: oop) or: [obj = manager hiddenRootsObject]). - fwd := manager fetchPointer: 0 ofObject: oop. - self assert: (self isPostMobile: fwd). - manager storePointerUnchecked: i ofObject: obj withValue: fwd]]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInInitialImmobileObjects (in category 'compaction') ----- updatePointersInInitialImmobileObjects "Sweep the initial immobile heap, updating all references to mobile objects to their eventual locations." manager allOldSpaceObjectsFrom: manager firstObject do: [:o| o >= firstFreeObject ifTrue: [^self]. self assert: (manager isMarked: o). + self updatePointersIn: o]! - self updatePointersIn: o startingAt: 0 savedFirstFieldPointer: nil]! Item was removed: - ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjects (in category 'compaction') ----- - updatePointersInMobileObjects - "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. - Remember to update the savedFirstFields of pointer objects, as these have been forwarded. - This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects." - - | toFinger top previousPin | - toFinger := manager startOfObject: firstFreeObject. - top := savedFirstFieldsSpace start - manager bytesPerOop. - self deny: (manager isMarked: firstFreeObject). - manager allOldSpaceEntitiesFrom: firstFreeObject do: - [:o| - self assert: (previousPin isNil or: [toFinger < previousPin]). - (manager isMarked: o) ifTrue: - [(manager isPinned: o) - ifTrue: - [self updatePointersIn: o startingAt: 0 savedFirstFieldPointer: nil. - previousPin ifNotNil: - [self assert: previousPin > toFinger. - ((manager isSegmentBridge: previousPin) - and: [manager isSegmentBridge: o]) ifTrue: - [self halt: 'empty segment']]. - previousPin := o] - ifFalse: - [| availableSpace bytes next | - (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: - [^false]. - [previousPin notNil - and: [availableSpace := (manager startOfObject: previousPin) - toFinger. - bytes := manager bytesInObject: o. - bytes ~= availableSpace - and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: - ["The object does not fit in the space between toFinger and previousPin. - Move toFinger beyond previousPin and update previousPin appropriately." - toFinger := manager addressAfter: previousPin. - next := manager objectStartingAt: toFinger. - next >= o ifTrue: - [^self continueUpdatePointersInMobileObjectsFrom: next]. - previousPin := (manager isPinned: next) ifTrue: [next]]. - ((manager formatOf: o) <= manager lastPointerFormat - and: [(manager numSlotsOf: o) > 0]) ifTrue: - [| oop fwd | - "Relocate the saved first field; Note that CompiledMethods can be excluded since their - first field is either a SmallInteger or a reference to a CogMethod outside of oldSpace." - oop := manager longAt: top. - ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: - [self assert: (manager isMarked: oop). - fwd := manager fetchPointer: 0 ofObject: oop. - self assert: (self isPostMobile: fwd). - manager longAt: top put: fwd]]. - self updatePointersIn: o startingAt: 1 savedFirstFieldPointer: top. - toFinger := toFinger + (manager bytesInObject: o)]]]. - ^true! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjectsWithTop: (in category 'compaction') ----- + updatePointersInMobileObjectsWithTop: initialTop + "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. + Remember to update the savedFirstFields of pointer objects, as these have been forwarded. + This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects." + + | toFinger top previousPin | + toFinger := manager startOfObject: firstFreeObject. + top := initialTop. + self deny: (manager isMarked: firstFreeObject). + manager allOldSpaceEntitiesFrom: firstFreeObject do: + [:o| + self assert: (previousPin isNil or: [toFinger < previousPin]). + (manager isMarked: o) ifTrue: + [(manager isPinned: o) + ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." + [self updatePointersIn: o. + previousPin ifNotNil: + [toFinger := manager addressAfter: previousPin]. + previousPin := o] + ifFalse: + [| availableSpace bytes next | + (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: + [^false]. + [previousPin notNil + and: [availableSpace := (manager startOfObject: previousPin) - toFinger. + bytes := manager bytesInObject: o. + bytes ~= availableSpace + and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: + ["The object does not fit in the space between toFinger and previousPin. + Move toFinger beyond previousPin and update previousPin appropriately." + toFinger := manager addressAfter: previousPin. + next := manager objectStartingAt: toFinger. + next >= o ifTrue: + [^self continueUpdatePointersInMobileObjectsFrom: next withTop: top]. + previousPin := (manager isPinned: next) ifTrue: [next]]. + self updatePointersIn: o savedFirstFieldPointer: top. + toFinger := toFinger + (manager bytesInObject: o)]]]. + ^true! Item was added: + ----- Method: SpurPlanningCompactor>>updatePointersInObjectsOverflowingSavedFirstFieldsSpace (in category 'compaction') ----- + updatePointersInObjectsOverflowingSavedFirstFieldsSpace + "Sweep the final immobile heap, is any (those objects with no room in savedFirstFieldsSpace + in the current pass) updating all references to mobile objects to their eventual locations." + manager allOldSpaceObjectsFrom: (manager objectAfter: lastMobileObject) do: + [:o| + self assert: (manager isMarked: o). + self updatePointersIn: o]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInSurvivingObjects (in category 'compaction') ----- updatePointersInSurvivingObjects "Sweep pastSpace, updating all references to mobile objects to their eventual locations." manager allPastSpaceObjectsDo: [:o| self assert: (manager isMarked: o). + self updatePointersIn: o]! - self updatePointersIn: o startingAt: 0 savedFirstFieldPointer: nil]!

1 0

Minheadless VM flavour status update
by Ronie Salgado 28 Dec '16

28 Dec '16

Hi all, I am happy to announce that my latest VM refactoring experiment is almost complete. I am only missing adding traditional style Makefiles to make Eliot happy ;), and making this work with MSVC. The minheadless is a VM variant that unifies a lot of the code for Windows, Linux and OS X. To the point that I am using the same CMake scripts for building on the three platforms. The minheadless VM is a completely headless by default VM, unless the configure script finds SDL2. If the configure script finds SDL2, and the legacy display interface is enabled(which is by default), then this VM will be built using SDL2 to implement the normal diplay primitives. The SDL2 backend work with normal Pharo and Squeak image. If SDL2 is not found by the configure script, or the legacy display primitives are disabled in the configure script, or the VM is started in headless mode, then the traditional display primitives are just going to be a /dev/null. Currently I am commiting this VM variant to the MinimalisticHeadless branch at: https://github.com/ronsaldo/opensmalltalk-vm/tree/MinimalisticHeadless For building using CMake it can be done in two ways: ------------------------------------ Calling CMake directly mkdir build cmake .. -DCMAKE_BUILD_TYPE=<The build type> (or cmake-gui ..) make The supported build types are: - Debug - Assert - RelWithDebInfo - Release If you are on an x86_64 system and you want to build 32 bits version, you have to pass the -DBUILD_I386_VERSION=True option to cmake. mkdir build cmake .. (or cmake-gui ..) make ------------------------------------ Using mvm style scripts Easy mode: cd build.minheadless.cmake/<x86 or x64>/vm_variant ./mvm A bit more complicated/flexible mode: This mvm will configure and build the vm for the four build types. This behavior was present on the mvm for Windows, so I am replicating it. In these same folders that are two other scripts: mvm_configure (calls cmake to only configure the build types), and mvm_configure_variant mvm_configure_variant is used to actually call cmake and configure the VM for building. The syntax of mvm_configure_variant is the following: mvm_configure_variant <BuildDirectory> <BuildType> Currently my workflow for using these scripts is the following with MSys/Cygwin/Linux: ./mvm_configure make -j8 The makefile at build.minheadless.cmake/<x86 or x64>/vm_variant is only used for delegating to the makefiles created by CMake. ------------------------------------ I am leaving some prebuilt Pharo VMs with the SDL2 backend for Windows for experimenting at: http://ronie.cl/files/vm/ Using OSWindow with this VM requires loading the latest version of OSWindow by reloading the ConfigurationOfOSWindow manually in Monticello, and then doing ConfigurationOfOSWindow load. With this VM, there are finally no more duplicated events. My TODO list for this includes adding plain Makefile. BTW: during the following week I will continue working with Lowcode. I really need it working again. Happy longest/shortest day of the year Ronie

6 6

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev December 2016