Vm-dev February 2014

vm-dev@lists.squeakfoundation.org

33 participants
83 discussions

VM Maker: VMMaker.oscog-eem.608.mcz
by commits＠source.squeak.org 05 Feb '14

05 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.608.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.608 Author: eem Time: 4 February 2014, 4:56:48.769 pm UUID: 121bef6b-4756-4027-bde8-b4eb972fa939 Ancestors: VMMaker.oscog-eem.607 Fix Spur's changeClassOf:to: =============== Diff against VMMaker.oscog-eem.607 =============== Item was changed: ----- Method: Spur32BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') ----- changeClassOf: rcvr to: argClass "Attempt to change the class of the receiver to the argument given that the format of the receiver matches the format of the argument. If successful, answer 0, otherwise answer an error code indicating the reason for failure. Fail if the format of the receiver is incompatible with the format of the argument, or if the argument is a fixed class and the receiver's size differs from the size that an instance of the argument should have." <inline: false> | classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex | classFormat := self formatOfClass: argClass. fixedFields := self fixedFieldsOfClassFormat: classFormat. + classFormat := self instSpecOfClassFormat: classFormat. instFormat := self formatOf: rcvr. normalizedInstFormat := self classFormatForInstanceFormat: instFormat. + (normalizedInstFormat > self lastPointerFormat + and: [normalizedInstFormat = classFormat]) - normalizedInstFormat = classFormat ifTrue: [newFormat := instFormat] ifFalse: [normalizedInstFormat <= self lastPointerFormat ifTrue: [classFormat > self lastPointerFormat ifTrue: [^PrimErrInappropriate]. (self numSlotsOf: rcvr) < fixedFields ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat] ifFalse: [| instBytes | instBytes := self byteLengthOf: rcvr. normalizedInstFormat caseOf: { [self sixtyFourBitIndexableFormat] -> [(classFormat < self sixtyFourBitIndexableFormat or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: [^PrimErrInappropriate]. newFormat := classFormat]. [self firstLongFormat] -> [(classFormat < self sixtyFourBitIndexableFormat or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: [^PrimErrInappropriate]. (classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat]. [self firstShortFormat] -> [(classFormat < self sixtyFourBitIndexableFormat or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: [^PrimErrInappropriate]. classFormat caseOf: { [self sixtyFourBitIndexableFormat] -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat]. [self firstLongFormat] -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat]. [self firstByteFormat] -> [newFormat := classFormat + (4 - instBytes bitAnd: 3)] }]. [self firstByteFormat] -> [(classFormat < self sixtyFourBitIndexableFormat or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: [^PrimErrInappropriate]. classFormat caseOf: { [self sixtyFourBitIndexableFormat] -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]]. [self firstLongFormat] -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]]. [self firstShortFormat] -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]] }. newFormat := classFormat]. [self firstCompiledMethodFormat] -> [classFormat ~= self firstCompiledMethodFormat ifTrue: [^PrimErrInappropriate]. newFormat := instFormat] }]]. (classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue: [^classIndex negated]. self setFormatOf: rcvr to: newFormat; setClassIndexOf: rcvr to: classIndex. "ok" ^0! Item was changed: ----- Method: Spur64BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') ----- changeClassOf: rcvr to: argClass "Attempt to change the class of the receiver to the argument given that the format of the receiver matches the format of the argument. If successful, answer 0, otherwise answer an error code indicating the reason for failure. Fail if the format of the receiver is incompatible with the format of the argument, or if the argument is a fixed class and the receiver's size differs from the size that an instance of the argument should have." <inline: false> | classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex | classFormat := self formatOfClass: argClass. fixedFields := self fixedFieldsOfClassFormat: classFormat. + classFormat := self instSpecOfClassFormat: classFormat. instFormat := self formatOf: rcvr. normalizedInstFormat := self classFormatForInstanceFormat: instFormat. + (normalizedInstFormat > self lastPointerFormat + and: [normalizedInstFormat = classFormat]) - normalizedInstFormat = classFormat ifTrue: [newFormat := instFormat] ifFalse: [normalizedInstFormat <= self lastPointerFormat ifTrue: [classFormat > self lastPointerFormat ifTrue: [^PrimErrInappropriate]. (self numSlotsOf: rcvr) < fixedFields ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat] ifFalse: [| instBytes | instBytes := self byteLengthOf: rcvr. normalizedInstFormat caseOf: { [self sixtyFourBitIndexableFormat] -> [(classFormat < self sixtyFourBitIndexableFormat or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: [^PrimErrInappropriate]. newFormat := classFormat]. [self firstLongFormat] -> [(classFormat < self sixtyFourBitIndexableFormat or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: [^PrimErrInappropriate]. (classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat]. [self firstShortFormat] -> [(classFormat < self sixtyFourBitIndexableFormat or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: [^PrimErrInappropriate]. classFormat caseOf: { [self sixtyFourBitIndexableFormat] -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat]. [self firstLongFormat] -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat + (2 - instBytes bitAnd: 1)]. [self firstByteFormat] -> [newFormat := classFormat + (8 - instBytes bitAnd: 7)] }]. [self firstByteFormat] -> [(classFormat < self sixtyFourBitIndexableFormat or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: [^PrimErrInappropriate]. classFormat caseOf: { [self sixtyFourBitIndexableFormat] -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat]. [self firstLongFormat] -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat + (2 - instBytes bitAnd: 1)]. [self firstShortFormat] -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]. newFormat := classFormat + (4 - instBytes bitAnd: 3)] }. newFormat := classFormat]. [self firstCompiledMethodFormat] -> [classFormat ~= self firstCompiledMethodFormat ifTrue: [^PrimErrInappropriate]. newFormat := instFormat] }]]. (classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue: [^classIndex negated]. self setFormatOf: rcvr to: newFormat; setClassIndexOf: rcvr to: classIndex. "ok" ^0!

1 0

VM Maker: VMMaker.oscog-eem.607.mcz
by commits＠source.squeak.org 05 Feb '14

05 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.607.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.607 Author: eem Time: 4 February 2014, 3:40:08.328 pm UUID: 9be0d8dc-ed68-4f51-becb-f83ed96185bf Ancestors: VMMaker.oscog-eem.606 Following forwarders in Spur markAndTrace: requires a store check. =============== Diff against VMMaker.oscog-eem.606 =============== Item was changed: ----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') ----- markAndTrace: objOop "Mark the argument, and all objects reachable from it, and any remaining objects on the mark stack. Follow forwarding pointers in the scan." <api> | objToScan numStrongSlots index field | (self markAndShouldScan: objOop) ifFalse: [^self]. "if markAndTrace: is to follow and eliminate forwarding pointers in its scan it cannot be handed an r-value which is forwarded." self assert: (self isForwarded: objOop) not. "Now scan the object, and any remaining objects on the mark stack." objToScan := objOop. "To avoid overflowing the mark stack when we encounter large objects, we push the obj, then its numStrongSlots, and then index the object from the stack." [((self isImmediate: objToScan) or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. numStrongSlots > self traceImmediatelySlotLimit]) ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any." [(self isImmediate: objToScan) ifTrue: [index := self integerValueOf: objToScan. objToScan := self topOfObjStack: markStack] ifFalse: [index := numStrongSlots. self markAndTraceClassOf: objToScan]. [index > 0] whileTrue: [index := index - 1. field := self fetchPointer: index ofObject: objToScan. (self isOopForwarded: field) ifTrue: [field := self followForwarded: field. + self storePointer: index ofObject: objToScan withValue: field]. - self storePointerUnchecked: index ofObject: objToScan withValue: field]. (self markAndShouldScan: field) ifTrue: [index > 0 ifTrue: [(self topOfObjStack: markStack) ~= objToScan ifTrue: [self push: objToScan onObjStack: markStack]. self push: (self integerObjectOf: index) onObjStack: markStack]. objToScan := field. index := -1]]. index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack." [objToScan := self popObjStack: markStack. objToScan = objOop ifTrue: [objToScan := self popObjStack: markStack]]] ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack." [index := numStrongSlots. self markAndTraceClassOf: objToScan. [index > 0] whileTrue: [index := index - 1. field := self fetchPointer: index ofObject: objToScan. (self isOopForwarded: field) ifTrue: [field := self followForwarded: field. + self storePointer: index ofObject: objToScan withValue: field]. - self storePointerUnchecked: index ofObject: objToScan withValue: field]. (self markAndShouldScan: field) ifTrue: [self push: field onObjStack: markStack. numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. numStrongSlots > self traceImmediatelySlotLimit ifTrue: [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]. objToScan := self popObjStack: markStack]. objToScan notNil] whileTrue!

1 0

VM Maker: VMMaker.oscog-eem.606.mcz
by commits＠source.squeak.org 04 Feb '14

04 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.606.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.606 Author: eem Time: 4 February 2014, 11:40:28.238 am UUID: d20e62c6-4468-4f78-91cb-8331c94a6ab7 Ancestors: VMMaker.oscog-eem.605 Demorgan CCodeGenerator>>shouldIncludeMethodFor:selector: so it doesn't include undefined options by default. This so that primitiveTestShortenIndexableSize stays in its ghetto. Make ObjectMemory>>allObjectsDo: use objectAfter: instead of objectAfterWhileForwarding:. Introduce allObjectsDoSafely: to use objectAfterWhileForwarding:. Add a compatibility method to Sour. Use allObjectsDoSafely: where appropriate. =============== Diff against VMMaker.oscog-eem.605 =============== Item was changed: ----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') ----- shouldIncludeMethodFor: aClass selector: selector "process optional methods by interpreting the argument to the option: pragma as either a Cogit class name or a class variable name or a variable name in VMBasicConstants." (aClass >> selector pragmaAt: #option:) ifNotNil: [:pragma| | key | key := pragma argumentAt: 1. vmMaker ifNotNil: + [(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue: + [| cogitClass optionClass | + cogitClass := Smalltalk classNamed: vmMaker cogitClassName. + optionClass := Smalltalk classNamed: key. + ^cogitClass includesBehavior: optionClass]. + (vmMaker options at: key ifAbsent: [false]) ifNotNil: + [:option| option ~~ false ifTrue: [^true]]. - [((Cogit withAllSubclasses anySatisfy: [:c| c name = key]) - and: [vmMaker cogitClassName ~= key]) ifTrue: - [^false]. - (vmMaker options at: key ifAbsent: []) ifNotNil: - [:option| option == false ifTrue: [^false]]]. (aClass bindingOf: key) ifNotNil: [:binding| + binding value ~~ false ifTrue: [^true]]. - binding value == false ifTrue: [^false]]. (VMBasicConstants bindingOf: key) ifNotNil: [:binding| + binding value ~~ false ifTrue: [^true]]]. + ^false]. - binding value == false ifTrue: [^false]]]. ^true! Item was changed: ----- Method: CogVMSimulator>>allObjectsSelect: (in category 'debug support') ----- allObjectsSelect: objBlock "self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]" | selected | selected := OrderedCollection new. + objectMemory allObjectsDoSafely: - objectMemory allObjectsDo: [:oop| (objBlock value: oop) ifTrue: [selected addLast: oop]]. ^ selected! Item was changed: ----- Method: NewObjectMemory>>allObjectsDo: (in category 'object enumeration') ----- allObjectsDo: aBlock <inline: true> | oop | oop := self firstObject. [oop < freeStart] whileTrue: [(self isFreeObject: oop) ifFalse: [aBlock value: oop]. + oop := self objectAfter: oop]! - oop := self objectAfterWhileForwarding: oop]! Item was added: + ----- Method: NewObjectMemory>>allObjectsDoSafely: (in category 'object enumeration') ----- + allObjectsDoSafely: aBlock + <inline: true> + | oop | + oop := self firstObject. + [oop < freeStart] whileTrue: + [(self isFreeObject: oop) ifFalse: + [aBlock value: oop]. + oop := self objectAfterWhileForwarding: oop]! Item was changed: ----- Method: ObjectMemory>>allObjects (in category 'primitive support') ----- allObjects "Attempt to answer an array of all objects, excluding those that may be garbage collected as a side effect of allocating the result array. If no memory is available answer 0." | count obj resultArray newCount | "Count the currently accessible objects" count := 0. self allObjectsDo: + [:ign| count := count + 1]. - [count := count + 1]. "Allocate result array, may cause GC" resultArray := self instantiateClass: self classArray indexableSize: count. resultArray = nil ifTrue: [^0]. "Store all objects in result array, excluding any reference to the result array itself, as may happen if garbage collection occurred during allocation of the array. No store check is necessary; the result array will be the last object in memory and hence new." newCount := 0. obj := self firstObject. [obj < resultArray] whileTrue: [(self isFreeObject: obj) ifFalse: [newCount := newCount + 1. self storePointerUnchecked: newCount ofObject: resultArray withValue: obj]. obj := self objectAfter: obj]. "If GC occurred during result array allocation, truncate unused portion of result array" newCount < count ifTrue: [self shorten: resultArray toIndexableSize: newCount]. ^resultArray! Item was changed: ----- Method: ObjectMemory>>allObjectsDo: (in category 'object enumeration') ----- allObjectsDo: aBlock <inline: true> | oop | oop := self firstObject. [oop < freeBlock] whileTrue: [(self isFreeObject: oop) ifFalse: [aBlock value: oop]. + oop := self objectAfter: oop]! - oop := self objectAfterWhileForwarding: oop]! Item was added: + ----- Method: ObjectMemory>>allObjectsDoSafely: (in category 'object enumeration') ----- + allObjectsDoSafely: aBlock + <inline: true> + | oop | + oop := self firstObject. + [oop < freeBlock] whileTrue: + [(self isFreeObject: oop) ifFalse: + [aBlock value: oop]. + oop := self objectAfterWhileForwarding: oop]! Item was added: + ----- Method: SpurMemoryManager>>allObjectsDoSafely: (in category 'object enumeration') ----- + allObjectsDoSafely: aBlock + <inline: true> + self allObjectsDo: aBlock! Item was changed: ----- Method: StackInterpreter>>allAccessibleObjectsOkay (in category 'debug support') ----- allAccessibleObjectsOkay "Ensure that all accessible objects in the heap are okay." | ok | ok := true. + objectMemory allObjectsDoSafely: - objectMemory allObjectsDo: [:oop| ok := ok & (self okayFields: oop)]. ^ok! Item was changed: ----- Method: StackInterpreter>>checkAllAccessibleObjectsOkay (in category 'debug support') ----- checkAllAccessibleObjectsOkay "Ensure that all accessible objects in the heap are okay." <api> | ok | ok := true. + objectMemory allObjectsDoSafely: - objectMemory allObjectsDo: [:oop| ok := ok & (self checkOkayFields: oop)]. ^ok! Item was changed: ----- Method: StackInterpreter>>printAllStacks (in category 'debug printing') ----- printAllStacks "Print all the stacks of all running processes, including those that are currently suspended." <api> | proc semaphoreClass mutexClass schedLists p processList | <inline: false> proc := self activeProcess. self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5; space; printHex: proc. self print: ' priority '; printNum: (self quickFetchInteger: PriorityIndex ofObject: proc); cr. self printCallStackFP: framePointer. "first the current activation" schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer. "then the runnable processes" p := highestRunnableProcessPriority = 0 ifTrue: [objectMemory fetchWordLengthOf: schedLists] ifFalse: [highestRunnableProcessPriority]. p - 1 to: 0 by: -1 do: [:pri| processList := objectMemory fetchPointer: pri ofObject: schedLists. (self isEmptyList: processList) ifFalse: [self cr; print: 'processes at priority '; printNum: pri + 1. self printProcsOnList: processList]]. self cr; print: 'suspended processes'. semaphoreClass := objectMemory classSemaphore. mutexClass := objectMemory classMutex. objectMemory hasSpurMemoryManagerAPI ifTrue: [semaphoreClass := objectMemory compactIndexOfClass: semaphoreClass. mutexClass := objectMemory compactIndexOfClass: mutexClass. objectMemory allHeapEntitiesDo: [:obj| | classIdx | classIdx := objectMemory classIndexOf: obj. (classIdx = semaphoreClass or: [classIdx = mutexClass]) ifTrue: [self printProcsOnList: obj]]] ifFalse: + [objectMemory allObjectsDoSafely: - [objectMemory allObjectsDo: [:obj| | classObj | classObj := objectMemory fetchClassOfNonImm: obj. (classObj = semaphoreClass or: [classObj = mutexClass]) ifTrue: [self printProcsOnList: obj]]]! Item was changed: ----- Method: StackInterpreterSimulator>>allObjectsSelect: (in category 'debug support') ----- allObjectsSelect: objBlock "self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]" | selected | selected := OrderedCollection new. + objectMemory allObjectsDoSafely: - objectMemory allObjectsDo: [:obj| (objBlock value: obj) ifTrue: [selected addLast: obj]]. ^selected!

1 0

VM Maker: VMMaker.oscog-eem.605.mcz
by commits＠source.squeak.org 04 Feb '14

04 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.605.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.605 Author: eem Time: 4 February 2014, 10:32:47.2 am UUID: 8ccb5e9c-1a6e-455f-8a97-1c30cca3ea1a Ancestors: VMMaker.oscog-eem.604 Confine primitiveTestShortenIndexableSize to a TestingPrimitives ghetto. =============== Diff against VMMaker.oscog-eem.604 =============== Item was changed: ----- Method: InterpreterPrimitives>>primitiveTestShortenIndexableSize (in category 'object access primitives') ----- primitiveTestShortenIndexableSize "Given an object with indexable pointer fields, reduce the size of the indexable fields to the requested size. Answer the number of bytes freed, or zero if the object cannot be shortened." + <option: #TestingPrimitives> - <export: true> | array newSize bytesFreed | newSize := self stackIntegerValue: 0. array := self stackValue: 1. self pop: argumentCount + 1. bytesFreed := self shorten: array toIndexableSize: newSize. self pushInteger: bytesFreed!

1 0

VM Maker: VMMaker.oscog-eem.604.mcz
by commits＠source.squeak.org 04 Feb '14

04 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.604.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.604 Author: eem Time: 4 February 2014, 10:24:54.015 am UUID: 3dedfc9d-e8c2-47ea-bb78-5dde624ade77 Ancestors: VMMaker.oscog-eem.603 Rewrite allocateLargestFreeChunk to skirt Slang limitation. =============== Diff against VMMaker.oscog-eem.603 =============== Item was changed: ----- Method: SpurMemoryManager>>allocateLargestFreeChunk (in category 'free space') ----- allocateLargestFreeChunk "Answer the largest free chunk in the free lists." + | freeChunk next | + "would like to use ifNotNil: but the ^next inside the ^blah ifNotNil: confused Slang" + freeChunk := self findLargestFreeChunk. + freeChunk ifNil: [^nil]. + "This will be the node, not a list element. Answer a list element in preference." + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk. + next ~= 0 ifTrue: + [self storePointer: self freeChunkNextIndex + ofFreeChunk: freeChunk + withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: next). + ^next]. + self unlinkSolitaryFreeTreeNode: freeChunk. + ^freeChunk! - ^self findLargestFreeChunk ifNotNil: - [:freeChunk| | next | - "This will be the node, not a list element. Answer a list element in preference." - next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk. - next ~= 0 ifTrue: - [self storePointer: self freeChunkNextIndex - ofFreeChunk: freeChunk - withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: next). - ^next]. - self unlinkSolitaryFreeTreeNode: freeChunk. - freeChunk]!

1 0

VM Maker: VMMaker.oscog-eem.603.mcz
by commits＠source.squeak.org 04 Feb '14

04 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.603.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.603 Author: eem Time: 4 February 2014, 10:07:52.921 am UUID: c1e131ed-4f5d-41fc-828a-f200c54a83b8 Ancestors: VMMaker.oscog-eem.602 and fix a snafu in the buildCodeGeneratorForCogit: refactoring. =============== Diff against VMMaker.oscog-eem.602 =============== Item was added: + ----- Method: VMMaker class>>generateAllSpurConfigurations (in category 'configurations') ----- + generateAllSpurConfigurations + self generateNewspeakSpurCogVM; + generateNewspeakSpurStackVM; + generateSqueakSpurCogVM; + generateSqueakSpurStackVM! Item was changed: ----- Method: VMMaker>>buildCodeGeneratorForCogit:includeAPIMethods:initializeClasses: (in category 'generate sources') ----- buildCodeGeneratorForCogit: cogitClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses "Answer the code generator for translating the cogit." | cg aClass cogitClasses apicg | cg := self createCogitCodeGenerator. cg vmClass: cogitClass. initializeClasses ifTrue: [{ cogitClass. self interpreterClass. self interpreterClass objectMemoryClass } do: [:cgc| (cgc respondsTo: #initializeWithOptions:) ifTrue: [cgc initializeWithOptions: optionsDictionary] ifFalse: [cgc initialize]]]. cogitClasses := OrderedCollection new. aClass := cogitClass. [cogitClasses addFirst: aClass. aClass ~~ Cogit and: [aClass inheritsFrom: Cogit]] whileTrue: + [aClass := aClass superclass]. - [aClass := cogitClass superclass]. cogitClasses addFirst: VMClass. cogitClasses addAllLast: ((cogitClass ancilliaryClasses: optionsDictionary) reject: [:class| class isStructClass]). cogitClasses do: [:cgc| cg addClass: cgc]. cg addStructClasses: (cg structClassesForTranslationClasses: cogitClasses). getAPIMethods ifTrue: [apicg := self buildCodeGeneratorForInterpreter: self interpreterClass includeAPIMethods: false initializeClasses: false. cg apiMethods: apicg selectAPIMethods]. ^cg!

1 0

VM Maker: VMMaker.oscog-eem.602.mcz
by commits＠source.squeak.org 04 Feb '14

04 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.602.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.602 Author: eem Time: 4 February 2014, 10:02:08.88 am UUID: aa08ab50-de50-4af2-9572-cdf179427de2 Ancestors: VMMaker.oscog-dtl.601 Refactor InterpreterPrimitives>>primitiveAllObjects to move creation and enumeration into objectMemory. Improve ObjectMemory>>allObjects by using fact that allocated object is always last object in heap. Implement SpurMemoryManager>>allObjects. For this, implement small/largeObjectBytesForSlots: and hence move allocateSlots:format:classIndex: et al up into SpurMemoryManager. Fix bug in simulator to find and compute the accessorDepth of named primitives in InterpreterPrimitives. Hence refactor code generator creation for Cogit and Interpreter into methods that allow the interpreter to be passed in as a parameter and class initialization avoided. Fix bad bug in Spur>>firstIndexableField: that shifted by wordSize instead of shiftForWord. Change some uses of wordSize to bytesPerSlot. =============== Diff against VMMaker.oscog-dtl.601 =============== Item was changed: ----- Method: InterpreterPrimitives>>primitiveAllObjects (in category 'object access primitives') ----- primitiveAllObjects + "Answer an array of all objects that exist when the primitive + is called, excluding those that may be garbage collected as + a side effect of allocating the result array." - "Answer an array of all objects that exist when the primitive is called, excluding those - that may be garbage collected as a side effect of allocating the result array. The array - will contain at least one trailing integer zero that serves as a marker for end of valid - object references. Additional trailing zeros represent objects that were garbage - collected during execution of this primitive. Sender is responsible for ignoring all - trailing zero marker objects in the result array." <export: true> + | result | + result := objectMemory allObjects. + result = 0 ifTrue: - | count obj resultArray newCount | - self pop: argumentCount+1. - "Count the currently accessible objects" - count := 0. - obj := objectMemory firstAccessibleObject. - [obj = nil] whileFalse: - [count := count + 1. - obj := objectMemory accessibleObjectAfter: obj]. - "Allocate result array, may cause GC" - resultArray := objectMemory instantiateClass: objectMemory classArray indexableSize: count. - resultArray = nil ifTrue: [^self primitiveFailFor: PrimErrNoMemory]. + self pop: argumentCount+1 thenPush: result! - "Store all objects in result array, excluding any reference to the result array - itself, as may happen if garbage collection occurred during allocation of the array." - newCount := 0. - obj := objectMemory firstAccessibleObject. - [obj = nil or: [newCount >= count]] whileFalse: - [obj == resultArray - ifFalse: [newCount := newCount + 1. - self stObject: resultArray at: newCount put: obj ]. - obj := objectMemory accessibleObjectAfter: obj]. - "If GC occurred during result array allocation, truncate unused portion of result array" - newCount < count - ifTrue: [self shorten: resultArray toIndexableSize: newCount]. - self push: resultArray! Item was added: + ----- Method: ObjectMemory>>allObjects (in category 'primitive support') ----- + allObjects + "Attempt to answer an array of all objects, excluding those that may + be garbage collected as a side effect of allocating the result array. + If no memory is available answer 0." + | count obj resultArray newCount | + "Count the currently accessible objects" + count := 0. + self allObjectsDo: + [count := count + 1]. + "Allocate result array, may cause GC" + resultArray := self instantiateClass: self classArray indexableSize: count. + resultArray = nil ifTrue: + [^0]. + "Store all objects in result array, excluding any reference to the result array itself, + as may happen if garbage collection occurred during allocation of the array. No store + check is necessary; the result array will be the last object in memory and hence new." + newCount := 0. + obj := self firstObject. + [obj < resultArray] whileTrue: + [(self isFreeObject: obj) ifFalse: + [newCount := newCount + 1. + self storePointerUnchecked: newCount ofObject: resultArray withValue: obj]. + obj := self objectAfter: obj]. + "If GC occurred during result array allocation, truncate unused portion of result array" + newCount < count ifTrue: + [self shorten: resultArray toIndexableSize: newCount]. + ^resultArray! 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)) - + ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)) to: #'oop *']. ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize + + ((self numSlotsOf: objOop) << self shiftForWord)) - + ((self numSlotsOf: objOop) << self wordSize)) to: #'oop *']. "All bit objects, and indeed CompiledMethod, though this is a non-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)) - + ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)) to: #'oop *']. ^self cCoerce: (self pointerForOop: objOop + self baseHeaderSize + + ((self numSlotsOf: objOop) << self shiftForWord)) - + ((self numSlotsOf: objOop) << self wordSize)) to: #'oop *']. "All bit objects, and indeed CompiledMethod, though this is a non-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 removed: - ----- Method: Spur32BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') ----- - allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex - "Allocate an object with numSlots in newSpace. This is for the `ee' execution engine allocations, - and must be satisfied. If no memory is available, abort. If the allocation pushes freeStart past - scavengeThreshold and a scavenge is not already scheduled, schedule a scavenge." - | numBytes newObj | - "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), - 16 bytes otherwise (num slots in preceeding word). - Objects always have at least one slot, for the forwarding pointer, - and are multiples of 8 bytes in length." - numSlots >= self numSlotsMask - ifTrue: - [newObj := freeStart + self baseHeaderSize. - numBytes := self baseHeaderSize + self baseHeaderSize "double header" - + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" - ifFalse: - [newObj := freeStart. - numBytes := self baseHeaderSize "single header" - + (numSlots <= 1 - ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" - ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" - freeStart + numBytes > scavengeThreshold ifTrue: - [needGCFlag ifFalse: [self scheduleScavenge]. - freeStart + numBytes > scavenger eden limit ifTrue: - [self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:'. - ^0]]. - numSlots >= self numSlotsMask - ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" - [self flag: #endianness. - self longAt: freeStart put: numSlots. - self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. - self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] - ifFalse: - [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. - self assert: numBytes \\ self allocationUnit = 0. - self assert: newObj \\ self allocationUnit = 0. - freeStart := freeStart + numBytes. - ^newObj! Item was removed: - ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- - allocateSlots: numSlots format: formatField classIndex: classIndex - "Allocate an object with numSlots space. If there is room beneath scavengeThreshold - allocate in newSpace, otherwise alocate in oldSpace. If there is not room in newSpace - and a scavenge is not already scheduled, schedule a scavenge." - <inline: true> - | numBytes newObj | - "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), - 16 bytes otherwise (num slots in preceeding word). - Objects always have at least one slot, for the forwarding pointer, - and are multiples of 8 bytes in length." - numSlots >= self numSlotsMask - ifTrue: - [newObj := freeStart + self baseHeaderSize. - numBytes := self baseHeaderSize + self baseHeaderSize "double header" - + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" - ifFalse: - [newObj := freeStart. - numBytes := self baseHeaderSize "single header" - + (numSlots <= 1 - ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" - ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" - freeStart + numBytes > scavengeThreshold ifTrue: - [needGCFlag ifFalse: [self scheduleScavenge]. - ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]. - numSlots >= self numSlotsMask - ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" - [self flag: #endianness. - self longAt: freeStart put: numSlots. - self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. - self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] - ifFalse: - [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. - self assert: numBytes \\ self allocationUnit = 0. - self assert: newObj \\ self allocationUnit = 0. - freeStart := freeStart + numBytes. - ^newObj! Item was changed: ----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') ----- fillObj: objOop numSlots: numSlots with: fillValue <inline: true> + self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1 - self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1 isLessThan: (self addressAfter: objOop)). objOop + self baseHeaderSize + to: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1 - to: objOop + self baseHeaderSize + (numSlots * self wordSize) - 1 by: self allocationUnit do: [:p| self longAt: p put: fillValue; longAt: p + 4 put: fillValue]! Item was changed: ----- Method: Spur32BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') ----- initFreeChunkWithBytes: numBytes at: address <var: #numBytes type: #usqLong> | numSlots | "must have room for a header (single or double) plus the next free pointer" self assert: (numBytes \\ self allocationUnit = 0 + and: [numBytes >= (self baseHeaderSize + self bytesPerSlot)]). - and: [numBytes >= (self baseHeaderSize + self wordSize)]). self flag: #endianness. "double header" numBytes >= ((self numSlotsMask << self shiftForWord) + self baseHeaderSize) ifTrue: [numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. self longAt: address put: numSlots; longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift; longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks" longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift. ^address + 8]. "single header" numSlots := numBytes - self baseHeaderSize >> self shiftForWord. self assert: numSlots < self numSlotsMask. self longAt: address put: 0; "0's classIndex; 0 = classIndex of free chunks" longAt: address + 4 put: numSlots << self numSlotsHalfShift. ^address! Item was added: + ----- Method: Spur32BitMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') ----- + largeObjectBytesForSlots: numSlots + "Answer the total number of bytes in an object with an overflow header, including header bytes." + ^self baseHeaderSize + self baseHeaderSize "double header" + + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot) "roundTo allocationUnit"! Item was added: + ----- Method: Spur32BitMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') ----- + smallObjectBytesForSlots: numSlots + "Answer the total number of bytes in an object without an overflow header, including header bytes." + ^self baseHeaderSize "single header" + + (numSlots <= 1 + ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" + ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot]) "round up to allocationUnit"! Item was removed: - ----- Method: Spur64BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') ----- - allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex - "Allocate an object with numSlots in newSpace. This is for the `ee' execution engine allocations, - and must be satisfied. If no memory is available, abort. If the allocation pushes freeStart past - scavengeThreshold and a scavenge is not already scheduled, schedule a scavenge." - | numBytes newObj | - "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), - 16 bytes otherwise (num slots in preceeding word). - Objects always have at least one slot, for the forwarding pointer, - and are multiples of 8 bytes in length." - numSlots >= self numSlotsMask - ifTrue: - [numSlots > 16rffffffff ifTrue: - [^nil]. - newObj := freeStart + self baseHeaderSize. - numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" - + (numSlots * self bytesPerSlot)] - ifFalse: - [newObj := freeStart. - numBytes := self baseHeaderSize "single header" - + (numSlots < 1 - ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" - ifFalse: [numSlots * self bytesPerSlot])]. - - freeStart + numBytes > scavengeThreshold ifTrue: - [needGCFlag ifFalse: [self scheduleScavenge]. - freeStart + numBytes > scavenger eden limit ifTrue: - [self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:'. - ^0]]. - numSlots >= self numSlotsMask - ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" - [self flag: #endianness. - self longAt: freeStart put: numSlots. - self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. - self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] - ifFalse: - [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. - self assert: numBytes \\ self allocationUnit = 0. - self assert: newObj \\ self allocationUnit = 0. - freeStart := freeStart + numBytes. - ^newObj! Item was removed: - ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- - allocateSlots: numSlots format: formatField classIndex: classIndex - "Allocate an object with numSlots space. If there is room beneath scavengeThreshold - allocate in newSpace, otherwise alocate in oldSpace. If there is not room in newSpace - and a scavenge is not already scheduled, schedule a scavenge." - <inline: true> - | numBytes newObj | - "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), - 16 bytes otherwise (num slots in preceeding word). - Objects always have at least one slot, for the forwarding pointer, - and are multiples of 8 bytes in length." - numSlots >= self numSlotsMask - ifTrue: - [numSlots > 16rffffffff ifTrue: - [^nil]. - newObj := freeStart + self baseHeaderSize. - numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" - + (numSlots * self bytesPerSlot)] - ifFalse: - [newObj := freeStart. - numBytes := self baseHeaderSize "single header" - + (numSlots < 1 - ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" - ifFalse: [numSlots * self bytesPerSlot])]. - - freeStart + numBytes > scavengeThreshold ifTrue: - [needGCFlag ifFalse: [self scheduleScavenge]. - ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]. - numSlots >= self numSlotsMask - ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" - [self flag: #endianness. - self longAt: freeStart put: numSlots. - self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. - self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] - ifFalse: - [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. - self assert: numBytes \\ self allocationUnit = 0. - self assert: newObj \\ self allocationUnit = 0. - freeStart := freeStart + numBytes. - ^newObj! Item was changed: ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header will have been filled-in but not the contents." <inline: false> | chunk | chunk := self allocateOldSpaceChunkOfBytes: totalBytes. + self checkFreeSpace. chunk ifNil: [^nil]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self longAt: chunk put: numSlots + (self numSlotsMask << self numSlotsFullShift). self longAt: chunk + self baseHeaderSize put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk + self baseHeaderSize) = lastSubdividedFreeChunk]). ^chunk + self baseHeaderSize]. self longAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk) = lastSubdividedFreeChunk]). ^chunk! Item was changed: ----- Method: Spur64BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') ----- fillObj: objOop numSlots: numSlots with: fillValue <inline: true> + self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1 - self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1 isLessThan: (self addressAfter: objOop)). objOop + self baseHeaderSize + to: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1 - to: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1 by: self allocationUnit do: [:p| self longAt: p put: fillValue]! Item was changed: ----- Method: Spur64BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') ----- initFreeChunkWithBytes: numBytes at: address <var: #numBytes type: #usqLong> | numSlots | "must have room for a header (single or double) plus the next free pointer" self assert: (numBytes \\ self allocationUnit = 0 + and: [numBytes >= (self baseHeaderSize + self bytesPerSlot)]). - and: [numBytes >= (self baseHeaderSize + self wordSize)]). "double header" numBytes >= ((self numSlotsMask << self shiftForWord) + self baseHeaderSize) ifTrue: [numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots; longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" ^address + 8]. "single header" numSlots := numBytes - self baseHeaderSize >> self shiftForWord. self assert: numSlots < self numSlotsMask. self longAt: address put: numSlots << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" ^address! Item was added: + ----- Method: Spur64BitMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') ----- + largeObjectBytesForSlots: numSlots + "Answer the total number of bytes in an object with an overflow header, including header bytes." + ^self baseHeaderSize + self baseHeaderSize "double header" + + (numSlots * self bytesPerSlot) "no rounding; bytesPerSlot = allocationUnit"! Item was added: + ----- Method: Spur64BitMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') ----- + smallObjectBytesForSlots: numSlots + "Answer the total number of bytes in an object without an overflow header, including header bytes." + ^self baseHeaderSize "single header" + + (numSlots < 1 + ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" + ifFalse: [numSlots * self bytesPerSlot])! Item was changed: ----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') ----- addFreeSubTree: freeTree "Add a freeChunk sub tree back into the large free chunk tree. This is for allocateOldSpaceChunkOf[Exactly]Bytes:[suchThat:]." | bytesInArg treeNode bytesInNode subNode | "N.B. *can't* use numSlotsOfAny: because of rounding up of odd slots and/or step in size at 1032 bytes in 32-bits or 2048 bytes in 64-bits." self assert: (self isFreeObject: freeTree). bytesInArg := self bytesInObject: freeTree. + self assert: bytesInArg / (self allocationUnit / self bytesPerSlot) >= self numFreeLists. - self assert: bytesInArg / (self allocationUnit / self wordSize) >= self numFreeLists. treeNode := freeLists at: 0. self assert: treeNode ~= 0. [bytesInNode := self bytesInObject: treeNode. self assert: bytesInArg ~= bytesInNode. bytesInNode > bytesInArg ifTrue: [subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode. subNode = 0 ifTrue: [self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree. self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode. ^self]] ifFalse: [subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode. subNode = 0 ifTrue: [self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree. self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode. ^self]]. treeNode := subNode] repeat! Item was changed: ----- Method: SpurMemoryManager>>allHeapEntitiesDo: (in category 'object enumeration') ----- allHeapEntitiesDo: aBlock + "N.B. e.g. allObjects relies on the old/new order here." <inline: true> + self allOldSpaceEntitiesDo: aBlock. + self allNewSpaceEntitiesDo: aBlock! - self allNewSpaceEntitiesDo: aBlock. - self allOldSpaceEntitiesDo: aBlock! Item was added: + ----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') ----- + allObjects + "Attempt to answer an array of all objects, excluding those that may + be garbage collected as a side effect of allocating the result array. + If no memory is available answer 0." + | freeChunk ptr start limit count bytes | + self markObjects. "don't want to revive objects unnecessarily." + freeChunk := self allocateLargestFreeChunk. + ptr := start := freeChunk + self baseHeaderSize. + limit := self addressAfter: freeChunk. + count := 0. + self allHeapEntitiesDo: + [:obj| "continue enumerating even if no room so as to unmark all objects." + (self isMarked: obj) ifTrue: + [(self isNormalObject: obj) + ifTrue: + [self setIsMarkedOf: obj to: false. + count := count + 1. + ptr < limit ifTrue: + [self longAt: ptr put: obj. + ptr := ptr + self bytesPerSlot]] + ifFalse: + [(self isSegmentBridge: obj) ifFalse: + [self setIsMarkedOf: obj to: false]]]]. + self assert: self allObjectsUnmarked. + self assert: count >= self numSlotsMask. + (count > (ptr - start / self bytesPerSlot) "not enough room" + or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word" + [self freeObject: freeChunk. + ^0]. + bytes := self largeObjectBytesForSlots: count. + start := self startOfObject: freeChunk. + self freeChunkWithBytes: limit - start - bytes at: start + bytes. + self setOverflowNumSlotsOf: freeChunk to: count. + self setClassIndexOf: freeChunk to: ClassArrayCompactIndex. + self setFormatOf: freeChunk to: self arrayFormat. + self possibleRootStoreInto: freeChunk. + ^freeChunk + + ! Item was changed: ----- Method: SpurMemoryManager>>allUnscannedEphemeronsAreActive (in category 'weakness and ephemerality') ----- allUnscannedEphemeronsAreActive + unscannedEphemerons start to: unscannedEphemerons top - self bytesPerSlot do: - unscannedEphemerons start to: unscannedEphemerons top - self wordSize do: [:p| | key | key := self keyOfEphemeron: (self longAt: p). ((self isImmediate: key) or: [self isMarked: key]) ifTrue: [^false]]. ^true! Item was changed: ----- Method: SpurMemoryManager>>allocateBytes:classIndex: (in category 'allocation') ----- allocateBytes: numBytes classIndex: classIndex "Allocate an object of numBytes. Answer nil if no available memory. classIndex must be that of a byte class (e.g. ByteString). The object is *NOT FILLED*." self assert: (coInterpreter addressCouldBeClassObj: (self classAtIndex: classIndex)). self assert: (self instSpecOfClass: (self classAtIndex: classIndex)) = self firstByteFormat. ^self + allocateSlots: (numBytes + self bytesPerSlot - 1 // self bytesPerSlot) + format: self firstByteFormat + (self bytesPerSlot - numBytes bitAnd: self bytesPerSlot - 1) - allocateSlots: (numBytes + self wordSize - 1 // self wordSize) - format: self firstByteFormat + (self wordSize - numBytes bitAnd: self wordSize - 1) classIndex: classIndex! Item was added: + ----- Method: SpurMemoryManager>>allocateLargestFreeChunk (in category 'free space') ----- + allocateLargestFreeChunk + "Answer the largest free chunk in the free lists." + ^self findLargestFreeChunk ifNotNil: + [:freeChunk| | next | + "This will be the node, not a list element. Answer a list element in preference." + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk. + next ~= 0 ifTrue: + [self storePointer: self freeChunkNextIndex + ofFreeChunk: freeChunk + withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: next). + ^next]. + self unlinkSolitaryFreeTreeNode: freeChunk. + freeChunk]! Item was changed: ----- Method: SpurMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') ----- allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex "Allocate an object with numSlots in newSpace. This is for the `ee' execution engine allocations, and must be satisfied. If no memory is available, abort. If the allocation pushes freeStart past scavengeThreshold and a scavenge is not already scheduled, schedule a scavenge." + | numBytes newObj | + "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), + 16 bytes otherwise (num slots in preceeding word). + Objects always have at least one slot, for the forwarding pointer, + and are multiples of 8 bytes in length." + numSlots >= self numSlotsMask + ifTrue: + [(self wordSize >= 8 and: [numSlots > 16rffffffff]) ifTrue: + [^nil]. "overflow size must fit in 32-bits" + newObj := freeStart + self baseHeaderSize. + numBytes := self largeObjectBytesForSlots: numSlots] + ifFalse: + [newObj := freeStart. + numBytes := self smallObjectBytesForSlots: numSlots]. + + freeStart + numBytes > scavengeThreshold ifTrue: + [needGCFlag ifFalse: [self scheduleScavenge]. + freeStart + numBytes > scavenger eden limit ifTrue: + [self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:'. + ^0]]. + numSlots >= self numSlotsMask + ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self flag: #endianness. + self longAt: freeStart put: numSlots. + self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] + ifFalse: + [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. + self assert: numBytes \\ self allocationUnit = 0. + self assert: newObj \\ self allocationUnit = 0. + freeStart := freeStart + numBytes. + ^newObj! - self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex "Allocate an object with numSlots space. If there is room beneath scavengeThreshold allocate in newSpace, otherwise alocate in oldSpace. If there is not room in newSpace and a scavenge is not already scheduled, schedule a scavenge." + <inline: true> + | numBytes newObj | + "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), + 16 bytes otherwise (num slots in preceeding word). + Objects always have at least one slot, for the forwarding pointer, + and are multiples of 8 bytes in length." + numSlots >= self numSlotsMask + ifTrue: + [(self wordSize >= 8 and: [numSlots > 16rffffffff]) ifTrue: + [^nil]. "overflow size must fit in 32-bits" + newObj := freeStart + self baseHeaderSize. + numBytes := self largeObjectBytesForSlots: numSlots] + ifFalse: + [newObj := freeStart. + numBytes := self smallObjectBytesForSlots: numSlots]. + + freeStart + numBytes > scavengeThreshold ifTrue: + [needGCFlag ifFalse: [self scheduleScavenge]. + ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]. + numSlots >= self numSlotsMask + ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self flag: #endianness. + self longAt: freeStart put: numSlots. + self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] + ifFalse: + [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. + self assert: numBytes \\ self allocationUnit = 0. + self assert: newObj \\ self allocationUnit = 0. + freeStart := freeStart + numBytes. + ^newObj! - self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') ----- firstIndexableField: objOop "NOTE: overridden in various simulator subclasses 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 weakArrayFormat ifTrue: [fmt = self arrayFormat ifTrue: "array starts at 0." [^self pointerForOop: objOop + self baseHeaderSize]. fmt >= self indexablePointersFormat ifTrue: "indexable with inst vars; need to delve into the class format word" [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop). ^self pointerForOop: objOop + self baseHeaderSize + + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)]. - + ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)]. "otherwise not indexable" ^0]. "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0" (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]) ifTrue: [^self pointerForOop: objOop + self baseHeaderSize]. "otherwise not indexable" ^0! Item was changed: ----- Method: SpurMemoryManager>>initializeUnscannedEphemerons (in category 'gc - global') ----- initializeUnscannedEphemerons "Initialize unscannedEphemerons to use the largest free chunk or unused eden space, which ever is the larger." | largestFree sizeOfUnusedEden | largestFree := self findLargestFreeChunk. sizeOfUnusedEden := scavenger eden limit - freeStart. (largestFree notNil and: [(self numSlotsOfAny: largestFree) > (sizeOfUnusedEden / self wordSize)]) ifTrue: [unscannedEphemerons + start: largestFree + + self baseHeaderSize + + (self freeChunkLargerIndex + 1 * self wordSize); - start: largestFree + self baseHeaderSize; limit: (self addressAfter: largestFree)] ifFalse: [unscannedEphemerons start: freeStart; limit: scavenger eden limit]. unscannedEphemerons top: unscannedEphemerons start! Item was added: + ----- Method: SpurMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') ----- + largeObjectBytesForSlots: numSlots + "Answer the total number of bytes in an object with an overflow header, including header bytes." + ^self subclassResponsibility! Item was changed: + ----- Method: SpurMemoryManager>>objectBytesForSlots: (in category 'allocation') ----- - ----- Method: SpurMemoryManager>>objectBytesForSlots: (in category 'object enumeration') ----- objectBytesForSlots: numSlots "Answer the total number of bytes in an object with the given number of slots, including header and possible overflow size header." self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>roundBytesToAllocationUnit: (in category 'allocation') ----- + roundBytesToAllocationUnit: bytes + ^bytes + (self allocationUnit - 1) bitClear: self allocationUnit - 1! Item was added: + ----- Method: SpurMemoryManager>>setOverflowNumSlotsOf:to: (in category 'free space') ----- + setOverflowNumSlotsOf: objOop to: numSlots + self flag: #endian. + self long32At: objOop - self baseHeaderSize put: numSlots! Item was added: + ----- Method: SpurMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') ----- + smallObjectBytesForSlots: numSlots + "Answer the total number of bytes in an object without an overflow header, including header bytes." + ^self subclassResponsibility! Item was changed: ----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') ----- tryLoadNewPlugin: pluginString pluginEntries: pluginEntries "Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin." <doNotGenerate> | plugin plugins simulatorClasses | self transcript cr; show: 'Looking for module ', pluginString. "Defeat loading of the FloatArrayPlugin & Matrix2x3Plugin since complications with 32-bit float support prevent simulation. If you feel up to tackling this start by implementing cCoerce: value to: cType ^cType = 'float' ifTrue: [value asIEEE32BitWord] ifFalse: [value] in FloatArrayPlugin & Matrix2x3Plugin and then address the issues in the BalloonEnginePlugin. See http://forum.world.st/Simulating-the-BalloonEnginePlugin-FloatArrayPlugin-a…" (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue: [self transcript show: ' ... defeated'. ^nil]. pluginString isEmpty ifTrue: [plugin := self] ifFalse: [plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString]. simulatorClasses := (plugins select: [:psc| psc simulatorClass notNil] thenCollect: [:psc| psc simulatorClass]) asSet. simulatorClasses isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil]. simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...']. plugins size > 1 ifTrue: [self transcript show: '...multiple plugin classes; choosing ', plugins last name]. plugin := simulatorClasses anyOne newFor: plugins last. "hopefully lowest in the hierarchy..." plugin setInterpreter: objectMemory. "Ignore return value from setInterpreter" (plugin respondsTo: #initialiseModule) ifTrue: [plugin initialiseModule ifFalse: [self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed" self transcript show: ' ... loaded'. objectMemory hasSpurMemoryManagerAPI ifTrue: [| realPlugin cg | self transcript show: '...computing accessor depths'. + plugin class isPluginClass + ifTrue: + [realPlugin := plugin class withAllSuperclasses detect: [:class| class shouldBeTranslated]. + cg := realPlugin buildCodeGeneratorUpTo: realPlugin] + ifFalse: + [cg := VMMaker new + buildCodeGeneratorForInterpreter: StackInterpreter + includeAPIMethods: false + initializeClasses: false]. - realPlugin := plugin class withAllSuperclasses detect: [:class| class shouldBeTranslated]. - cg := realPlugin buildCodeGeneratorUpTo: realPlugin. cg exportedPrimitiveNames do: [:primName| | fnSymbol | fnSymbol := primName asSymbol. pluginEntries addLast: {plugin. fnSymbol. [plugin perform: fnSymbol. self]. cg accessorDepthForSelector: fnSymbol}]. self transcript show: '...done']. ^pluginString asString -> plugin! 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." bootstrapping := false. objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. objectMemory coInterpreter: self. "Note: we must initialize ConstMinusOne differently for simulation, due to the fact that the simulator works only with +ve 32-bit values" ConstMinusOne := objectMemory integerObjectOf: -1. methodCache := Array new: MethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. + objectMemory hasSpurMemoryManagerAPI + ifTrue: + [primitiveAccessorDepthTable := self class primitiveAccessorDepthTable. + pluginList := {}] + ifFalse: + [pluginList := {'' -> self }]. - primitiveAccessorDepthTable := objectMemory hasSpurMemoryManagerAPI ifTrue: - [self class primitiveAccessorDepthTable]. - pluginList := {'' -> self }. mappedPluginEntries := OrderedCollection new. desiredNumStackPages := desiredEdenBytes := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := Time totalSeconds * 1000000. "initialize InterpreterSimulator variables used for debugging" byteCount := 0. sendCount := 0. quitBlock := [^ self]. traceOn := true. printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. transcript := Transcript. displayForm := 'Display has not yet been installed' asDisplayText form. suppressHeartbeatFlag := false. systemAttributes := Dictionary new. extSemTabSize := 256. disableBooleanCheat := false! Item was changed: ----- Method: VMMaker>>buildCodeGeneratorForCogit (in category 'generate sources') ----- buildCodeGeneratorForCogit "Answer the code generator for translating the cogit." + ^self + buildCodeGeneratorForCogit: self cogitClass + includeAPIMethods: true + initializeClasses: true! - ^self buildCodeGeneratorForCogit: true! Item was removed: - ----- Method: VMMaker>>buildCodeGeneratorForCogit: (in category 'generate sources') ----- - buildCodeGeneratorForCogit: getAPIMethods - "Answer the code generator for translating the cogit." - - | cg cogitClass cogitClasses apicg | - cg := self createCogitCodeGenerator. - - cg vmClass: (cogitClass := self cogitClass). - { cogitClass. self interpreterClass. self interpreterClass objectMemoryClass } do: - [:cgc| - (cgc respondsTo: #initializeWithOptions:) - ifTrue: [cgc initializeWithOptions: optionsDictionary] - ifFalse: [cgc initialize]]. - - cogitClasses := OrderedCollection new. - [cogitClasses addFirst: cogitClass. - cogitClass ~~ Cogit - and: [cogitClass inheritsFrom: Cogit]] whileTrue: - [cogitClass := cogitClass superclass]. - cogitClasses addFirst: VMClass. - cogitClasses addAllLast: ((self cogitClass ancilliaryClasses: optionsDictionary) reject: [:class| class isStructClass]). - cogitClasses do: [:cgc| cg addClass: cgc]. - cg addStructClasses: (cg structClassesForTranslationClasses: cogitClasses). - - getAPIMethods ifTrue: - [apicg := self buildCodeGeneratorForInterpreter: false. - cg apiMethods: apicg selectAPIMethods]. - - ^cg! Item was added: + ----- Method: VMMaker>>buildCodeGeneratorForCogit:includeAPIMethods:initializeClasses: (in category 'generate sources') ----- + buildCodeGeneratorForCogit: cogitClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses + "Answer the code generator for translating the cogit." + + | cg aClass cogitClasses apicg | + cg := self createCogitCodeGenerator. + + cg vmClass: cogitClass. + initializeClasses ifTrue: + [{ cogitClass. self interpreterClass. self interpreterClass objectMemoryClass } do: + [:cgc| + (cgc respondsTo: #initializeWithOptions:) + ifTrue: [cgc initializeWithOptions: optionsDictionary] + ifFalse: [cgc initialize]]]. + + cogitClasses := OrderedCollection new. + aClass := cogitClass. + [cogitClasses addFirst: aClass. + aClass ~~ Cogit + and: [aClass inheritsFrom: Cogit]] whileTrue: + [aClass := cogitClass superclass]. + cogitClasses addFirst: VMClass. + cogitClasses addAllLast: ((cogitClass ancilliaryClasses: optionsDictionary) reject: [:class| class isStructClass]). + cogitClasses do: [:cgc| cg addClass: cgc]. + cg addStructClasses: (cg structClassesForTranslationClasses: cogitClasses). + + getAPIMethods ifTrue: + [apicg := self + buildCodeGeneratorForInterpreter: self interpreterClass + includeAPIMethods: false + initializeClasses: false. + cg apiMethods: apicg selectAPIMethods]. + + ^cg! Item was changed: ----- Method: VMMaker>>buildCodeGeneratorForInterpreter (in category 'generate sources') ----- buildCodeGeneratorForInterpreter "Answer the code generator for translating the interpreter." + ^self + buildCodeGeneratorForInterpreter: self interpreterClass + includeAPIMethods: true + initializeClasses: true! - ^self buildCodeGeneratorForInterpreter: true! Item was removed: - ----- Method: VMMaker>>buildCodeGeneratorForInterpreter: (in category 'generate sources') ----- - buildCodeGeneratorForInterpreter: getAPIMethods - "Answer the code generator for translating the interpreter." - - | cg interpreterClass interpreterClasses apicg | - interpreterClasses := OrderedCollection new. - - interpreterClass := self interpreterClass. - interpreterClass initializeWithOptions: optionsDictionary. - - (cg := self createCodeGenerator) vmClass: interpreterClass. - - [interpreterClass ~~ VMClass] whileTrue: - [interpreterClasses addFirst: interpreterClass. - interpreterClass := interpreterClass superclass]. - - cg vmClass objectMemoryClass ifNotNil: - [:objectMemoryClass| - interpreterClass := objectMemoryClass. - [interpreterClass ~~ VMClass] whileTrue: - [interpreterClasses addFirst: interpreterClass. - interpreterClass := interpreterClass superclass]]. - - interpreterClasses addFirst: VMClass. - interpreterClasses addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses). - - interpreterClasses do: - [:ic| - (ic respondsTo: #initializeWithOptions:) - ifTrue: [ic initializeWithOptions: optionsDictionary] - ifFalse: [ic initialize]]. - (cg structClassesForTranslationClasses: interpreterClasses) do: - [:structClass| structClass initialize]. - - cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses). - - interpreterClasses do: [:ic| cg addClass: ic]. - - (getAPIMethods - and: [self interpreterClass needsCogit]) ifTrue: - [apicg := self buildCodeGeneratorForCogit: false. - cg apiMethods: apicg selectAPIMethods]. - - ^cg! Item was added: + ----- Method: VMMaker>>buildCodeGeneratorForInterpreter:includeAPIMethods:initializeClasses: (in category 'generate sources') ----- + buildCodeGeneratorForInterpreter: interpreterClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses + "Answer the code generator for translating the interpreter." + + | cg theClass interpreterClasses apicg | + interpreterClasses := OrderedCollection new. + + initializeClasses ifTrue: + [interpreterClass initializeWithOptions: optionsDictionary]. + + (cg := self createCodeGenerator) vmClass: interpreterClass. + + theClass := interpreterClass. + [theClass ~~ VMClass] whileTrue: + [interpreterClasses addFirst: theClass. + theClass := theClass superclass]. + + cg vmClass objectMemoryClass ifNotNil: + [:objectMemoryClass| + theClass := objectMemoryClass. + [theClass ~~ VMClass] whileTrue: + [interpreterClasses addFirst: theClass. + theClass := theClass superclass]]. + + interpreterClasses addFirst: VMClass. + interpreterClasses addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses). + + initializeClasses ifTrue: + [interpreterClasses do: + [:ic| + (ic respondsTo: #initializeWithOptions:) + ifTrue: [ic initializeWithOptions: optionsDictionary] + ifFalse: [ic initialize]]. + (cg structClassesForTranslationClasses: interpreterClasses) do: + [:structClass| structClass initialize]]. + + cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses). + + interpreterClasses do: [:ic| cg addClass: ic]. + + (getAPIMethods + and: [self interpreterClass needsCogit]) ifTrue: + [apicg := self + buildCodeGeneratorForCogit: self cogitClass + includeAPIMethods: false + initializeClasses: false. + cg apiMethods: apicg selectAPIMethods]. + + ^cg!

1 0

Re: [Vm-dev] VM Maker: VMMaker.oscog-dtl.601.mcz
by David T. Lewis 02 Feb '14

02 Feb '14

Hi Eliot, This is the primitiveAllObjects update. I made significant changes in shorten:toIndexableSize: after having discovered a number of interesting new ways to crash the VM, so you will want to review those changes. There is also a primitiveTestShortenIndexableSize that exists solely for the purpose of exercising shorten:toIndexableSize: from the image. This should probably not be a permanent addition to the VM. I built a Cog VM with these changes, and it seems to be fine. That said, most of my testing was done on an interpreter VM and there are some difference in the NewObjectMemory shorten:toIndexableSize: method, so please do check it. I used the attached Foo.st for testing, you may find that useful also. Dave On Sun, Feb 02, 2014 at 07:51:41PM +0000, commits(a)source.squeak.org wrote: > > David T. Lewis uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-dtl.601.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-dtl.601 > Author: dtl > Time: 2 February 2014, 2:50:58.398 pm > UUID: 0074410d-1695-4af5-82f4-c74b52a35a9e > Ancestors: VMMaker.oscog-eem.600 > > Fix NewObjectMemory>>shorten:toIndexableSize: for large arrays (3 word header) and make it work for variable objects with fixed fields. Change return value to be number of bytes freed, to permit sender to check for success. > > Fix method comment in ObjectMemory>>lengthOf:baseHeader:format: > > Add primitiveAllObjects. > > Add primitiveTestShortenIndexableSize for testing shorten:toIndexableSize: from the image. > > Adapted from VMMaker-dtl.339.mcz >

1 0

VM Maker: VMMaker.oscog-dtl.601.mcz
by commits＠source.squeak.org 02 Feb '14

02 Feb '14

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-dtl.601.mcz ==================== Summary ==================== Name: VMMaker.oscog-dtl.601 Author: dtl Time: 2 February 2014, 2:50:58.398 pm UUID: 0074410d-1695-4af5-82f4-c74b52a35a9e Ancestors: VMMaker.oscog-eem.600 Fix NewObjectMemory>>shorten:toIndexableSize: for large arrays (3 word header) and make it work for variable objects with fixed fields. Change return value to be number of bytes freed, to permit sender to check for success. Fix method comment in ObjectMemory>>lengthOf:baseHeader:format: Add primitiveAllObjects. Add primitiveTestShortenIndexableSize for testing shorten:toIndexableSize: from the image. Adapted from VMMaker-dtl.339.mcz =============== Diff against VMMaker.oscog-eem.600 =============== Item was added: + ----- Method: InterpreterPrimitives>>primitiveAllObjects (in category 'object access primitives') ----- + primitiveAllObjects + "Answer an array of all objects that exist when the primitive is called, excluding those + that may be garbage collected as a side effect of allocating the result array. The array + will contain at least one trailing integer zero that serves as a marker for end of valid + object references. Additional trailing zeros represent objects that were garbage + collected during execution of this primitive. Sender is responsible for ignoring all + trailing zero marker objects in the result array." + + <export: true> + | count obj resultArray newCount | + self pop: argumentCount+1. + "Count the currently accessible objects" + count := 0. + obj := objectMemory firstAccessibleObject. + [obj = nil] whileFalse: + [count := count + 1. + obj := objectMemory accessibleObjectAfter: obj]. + "Allocate result array, may cause GC" + resultArray := objectMemory instantiateClass: objectMemory classArray indexableSize: count. + resultArray = nil ifTrue: + [^self primitiveFailFor: PrimErrNoMemory]. + "Store all objects in result array, excluding any reference to the result array + itself, as may happen if garbage collection occurred during allocation of the array." + newCount := 0. + obj := objectMemory firstAccessibleObject. + [obj = nil or: [newCount >= count]] whileFalse: + [obj == resultArray + ifFalse: [newCount := newCount + 1. + self stObject: resultArray at: newCount put: obj ]. + obj := objectMemory accessibleObjectAfter: obj]. + "If GC occurred during result array allocation, truncate unused portion of result array" + newCount < count + ifTrue: [self shorten: resultArray toIndexableSize: newCount]. + self push: resultArray! Item was added: + ----- Method: InterpreterPrimitives>>primitiveTestShortenIndexableSize (in category 'object access primitives') ----- + primitiveTestShortenIndexableSize + "Given an object with indexable pointer fields, reduce the size of the indexable fields + to the requested size. Answer the number of bytes freed, or zero if the object cannot + be shortened." + + <export: true> + | array newSize bytesFreed | + newSize := self stackIntegerValue: 0. + array := self stackValue: 1. + self pop: argumentCount + 1. + bytesFreed := self shorten: array toIndexableSize: newSize. + self pushInteger: bytesFreed! Item was changed: ----- Method: NewObjectMemory>>shorten:toIndexableSize: (in category 'allocation') ----- shorten: obj toIndexableSize: nSlots + "Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the + unused residual to a free chunk. Word and byte indexable objects are not changed. + Answer the number of bytes returned to free memory, which may be zero if no change + was possible." + | deltaBytes desiredLength fixedFields fmt hdr totalLength + indexableFields | + (self isPointersNonImm: obj) ifFalse: [^0]. + nSlots > 0 + ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative" - "Currently this works for pointer objects only, and is almost certainly wrong for 64 bits." - | deltaBytes desiredLength fixedFields fmt hdr totalLength | - (self isPointersNonImm: obj) ifFalse: - [^obj]. hdr := self baseHeader: obj. fmt := self formatOfHeader: hdr. totalLength := self lengthOf: obj baseHeader: hdr format: fmt. fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength. + indexableFields := totalLength - fixedFields. + nSlots >= indexableFields + ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk" + desiredLength := fixedFields + nSlots. - desiredLength := fixedFields + nSlots. deltaBytes := (totalLength - desiredLength) * BytesPerWord. obj + BaseHeaderSize + (totalLength * BytesPerWord) = freeStart ifTrue: "Shortening the last object. Need to reduce freeStart." [self maybeFillWithAllocationCheckFillerFrom: obj + BaseHeaderSize + (desiredLength * BytesPerWord) to: freeStart. freeStart := obj + BaseHeaderSize + (desiredLength * BytesPerWord)] ifFalse: "Shortening some interior object. Need to create a free block." [self setSizeOfFree: obj + BaseHeaderSize + (desiredLength * BytesPerWord) to: deltaBytes]. (self headerType: obj) caseOf: { [HeaderTypeSizeAndClass] -> + [self longAt: (obj - (BaseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes]. - [self longAt: obj put: hdr - deltaBytes]. [HeaderTypeClass] -> [self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)]. [HeaderTypeShort] -> [self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)] }. + ^deltaBytes! - ^obj! Item was changed: ----- Method: ObjectMemory>>lengthOf:baseHeader:format: (in category 'indexing primitive support') ----- lengthOf: oop baseHeader: hdr format: fmt + "Return the number of fixed and indexable bytes, words, or object pointers in the + given object. Assume the given oop is not an integer. For a CompiledMethod, the size + of the method header (in bytes) should be subtracted from the result of this method." - "Return the number of indexable bytes or words in the given object. Assume the given oop is not an integer. For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result of this method." | sz | <inline: true> <asmLabel: false> (hdr bitAnd: TypeMask) = HeaderTypeSizeAndClass ifTrue: [ sz := (self sizeHeader: oop) bitAnd: LongSizeMask ] ifFalse: [ sz := (hdr bitAnd: SizeMask)]. sz := sz - (hdr bitAnd: Size4Bit). fmt <= self lastPointerFormat ifTrue: [ ^ (sz - BaseHeaderSize) >> ShiftForWord "words"]. ^fmt < self firstByteFormat ifTrue: [(sz - BaseHeaderSize) >> 2 "32-bit longs"] ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3) "bytes"]! Item was changed: ----- Method: ObjectMemory>>shorten:toIndexableSize: (in category 'allocation') ----- shorten: obj toIndexableSize: nSlots + "Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the + unused residual to a free chunk. Word and byte indexable objects are not changed. + Answer the number of bytes returned to free memory, which may be zero if no change + was possible." + | deltaBytes desiredLength fixedFields fmt hdr totalLength + indexableFields | + (self isPointersNonImm: obj) ifFalse: [^0]. + nSlots > 0 + ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative" - "Currently this works for pointer objects only, and is almost certainly wrong for 64 bits." - | deltaBytes desiredLength fixedFields fmt hdr totalLength | - (self isPointersNonImm: obj) ifFalse: - [^obj]. hdr := self baseHeader: obj. fmt := self formatOfHeader: hdr. totalLength := self lengthOf: obj baseHeader: hdr format: fmt. fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength. + indexableFields := totalLength - fixedFields. + nSlots >= indexableFields + ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk" + desiredLength := fixedFields + nSlots. - desiredLength := fixedFields + nSlots. deltaBytes := (totalLength - desiredLength) * BytesPerWord. self setSizeOfFree: obj + BaseHeaderSize + (desiredLength * BytesPerWord) to: deltaBytes. (self headerType: obj) caseOf: { [HeaderTypeSizeAndClass] -> + [self longAt: (obj - (BaseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes]. - [self longAt: obj put: hdr - deltaBytes]. [HeaderTypeClass] -> [self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)]. [HeaderTypeShort] -> [self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)] }. + ^deltaBytes! - ^obj!

1 0

(No Subject)
by gettimothy 01 Feb '14

01 Feb '14

>> Not necessarily. There should be a SimulatorMorph that holds onto the simulator itself and embeds the image morph. That could present a nice UI, and could either handle events itself, or register event handlers with the image morph. If you need UI ideas I suggest you try my >>SqueakJS morph (which essintially is also a VM simulator): http://lively-web.org/users/bert/squeak.html It's a shame we never bothered to make the simulator this nice ;) >> >+1 agreed >It would be great if someone were to take inspiration from Bert's SqueakJS >morph and do something similar for the traditional VM simulators. >Personally, it's inspiring me to want to learn about JS some day soon. That >lively VM is seriously impressive. +2 >Dave Bert's work is inspiring and a very impressive. After mulling on it yesterday and poking around a bit, I decided Bert's Morphic approach is the way to go for now. My reasoning is that I saw no easy way of filtering out mouse-move events from other mouse events (most mouse move events happen outside the scope of the simulator) and mouse coordinate translation is needed with the Semaphore approach. Please bear in mind that my stated goal is to port the StackInterpreterSimulator /StackInterpreter to native 64 bits and then to 64x64 (native 64 running a 64 bit image). That exercise is the foundation of upping my programming chops so that I can break out of the UI/Web/DB application programmer rut I am in. >From there, Eliot needs help porting Cog to 64 native. I do not want to detour from that goal too much except to correct learning deficiencies and to help with some fixes to plugins. That said, I do have a free day or two so I will try to stub what Bert has in place visually with the idea of bringing in the functionality as I learn it. I REALLY like that step functionality, and the view of the MethodContext. Also, I do not understand how debuggers work, and looking at what Bert has, it looks like a lot of debugger techniques are used; That in itself is a very useful exercise. >Tim R. wrote: >A useful UI for the simulator would allow pushing in events that are *not* those going on in the outer world; some way to send in a variety of keyboard/button events would help with making sure that the event handling can cope with variations not provided by your host. For >example, some platforms send a triple of keydown/keystroke/keyup for each keyboard press. Some do it quite differently. Or say one is trying to develop handling for a new event that isn’t actually provided by any VM yet (OS_TeaTime_Alert, for example) and you want to make >sure it can work. >At the very least it might lead to some decent documentation of WTF goes on down there. Tim. I have this noted in my working notes. Since events are just CArrayAccessors, the structure is fixed and I do think a pop-up that allows you to set and send an event that is fed to the interpreter is doable. cordially, tty.

1 0

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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev February 2014