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

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

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

Name: VMMaker.oscog-eem.2252
Author: eem
Time: 7 July 2017, 5:06:09.422305 pm
UUID: 2f3e9b0e-ecd3-4adf-b092-cce2e2587a5c
Ancestors: VMMaker.oscog-eem.2251

SpurImageSegments
Fix some signed comparisons in mapOopsAndValidateClassRefsFrom:to:outPointers:.

Add class side analysis a la SpurPlanningCompactor.

Slang:
Propagate types from "ible" to "var" in "var := ible := expr" when inferring types from assignments.

=============== Diff against VMMaker.oscog-eem.2251 ===============

Item was added:
+ ----- Method: SpurMemoryManager class>>identify32BitSignedComparisonsInSegmentIO (in category 'analysis') -----
+ identify32BitSignedComparisonsInSegmentIO
+ "self identify32BitSignedComparisonsInSegmentIO"
+ self identifySignedComparisonsFor: #(ObjectMemory Spur32BitMemoryManager)
+ in: (self organization listAtCategoryNamed: #'image segment in/out')
+ noise: #( 'classIndex* >= numOutPointers'
+ 'count > ptr - start / self bytesPerOop'
+ 'endSeg - segAddr < self baseHeaderSize + self bytesPerOop'
+ 'errorCode* > 0'
+ 'GCModeImageSegment > 0'
+ 'hash - TopHashBit <= outIndex'
+ 'limit - ptr <= 8'
+ 'num* >= self numSlotsMask'
+ 'num* <= 1'
+ 'outIndex >= (self numSlotsOf: outPointerArray)'
+ 'outIndex := self mapOopsFrom: * < 0'
+ 'segAddr - segStart / 8 + self lastClassIndexPun >= TopHashBit'
+ 'there > 0'
+ '* > self identityHashHalfWordMask'
+ '*segmentLimit >= self numSlotsMask*'
+ '* > self isForwardedObjectClassIndexPun'
+ '* > self lastClassIndexPun')!

Item was added:
+ ----- Method: SpurMemoryManager class>>identify64BitSignedComparisonsInSegmentIO (in category 'analysis') -----
+ identify64BitSignedComparisonsInSegmentIO
+ "self identify64BitSignedComparisonsInSegmentIO"
+ self identifySignedComparisonsFor: #(ObjectMemory Spur64BitMemoryManager)
+ in: (self organization listAtCategoryNamed: #'image segment in/out')
+ noise: #( 'classIndex* >= numOutPointers'
+ 'count > ptr - start / self bytesPerOop'
+ 'endSeg - segAddr < self baseHeaderSize + self bytesPerOop'
+ 'errorCode* > 0'
+ 'GCModeImageSegment > 0'
+ 'hash - TopHashBit <= outIndex'
+ 'limit - ptr <= 8'
+ 'num* >= self numSlotsMask'
+ 'num* <= 1'
+ 'num* > 0'
+ 'num* < 1'
+ 'outIndex >= (self numSlotsOf: outPointerArray)'
+ 'outIndex := self mapOopsFrom: * < 0'
+ 'segAddr - segStart / 8 + self lastClassIndexPun >= TopHashBit'
+ 'there > 0'
+ '* > self identityHashHalfWordMask'
+ '*segmentLimit >= self numSlotsMask*'
+ '* > self isForwardedObjectClassIndexPun'
+ '* > self lastClassIndexPun')!

Item was added:
+ ----- Method: SpurMemoryManager class>>identifySignedComparisonsFor:in:noise: (in category 'analysis') -----
+ identifySignedComparisonsFor: options in: selectors noise: noise
+ "self identify32BitSignedComparisonsInSegmentIO"
+ "self identify64BitSignedComparisonsInSegmentIO"
+ | vmm cg halt |
+ halt := false.
+ vmm := (VMMaker forPlatform: 'Cross')
+ interpreterClass: StackInterpreter;
+ options: options.
+ cg := [vmm buildCodeGeneratorForInterpreter]
+ on: Notification
+ do: [:ex|
+ ex tag == #getVMMaker
+ ifTrue: [ex resume: vmm]
+ ifFalse: [ex pass]].
+ cg vmClass preGenerationHook: cg.
+ cg inferTypesForImplicitlyTypedVariablesAndMethods.
+ cg retainMethods: self selectors.
+ cg prepareMethods.
+ cg doInlining: true.
+ selectors sort do:
+ [:sel|
+ (cg methodNamed: sel) ifNotNil:
+ [:m|
+ m parseTree nodesDo:
+ [:node|
+ (node isSend
+ and: [(#(< > <= >=) includes: node selector)
+ and: [({node receiver. node args first } anySatisfy:
+ [:o| (cg typeFor: o in: m)
+ ifNil: [true]
+ ifNotNil: [:t| (cg isIntegralCType: t) and: [t first ~= $u]]])
+ and: [noise noneSatisfy: [:n| n match: node printString]]]]) ifTrue:
+ [halt ifTrue: [self halt: node printString].
+ Transcript ensureCr; nextPutAll: sel; space; print: node; flush]]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>mapOopsAndValidateClassRefsFrom:to:outPointers: (in category 'image segment in/out') -----
  mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray
  "This is part of loadImageSegmentFrom:outPointers:.
  Scan through mapping oops and validating class references.  Defer
  entering any class objects into the class table and/or pinning objects
  until the second pass in assignClassIndicesAndPinFrom:to:outPointers:."
+ <var: 'segmentLimit' type: #usqInt>
  | numOutPointers numSegObjs objOop |
+ <var: #oop type: #usqInt>
  numOutPointers := self numSlotsOf: outPointerArray.
  numSegObjs := 0.
  objOop := self objectStartingAt: segmentStart.
  [self oop: objOop isLessThan: segmentLimit] whileTrue:
  [| classIndex hash oop mappedOop |
  numSegObjs := numSegObjs + 1.
  "No object in the segment should be marked.  If is is something is wrong."
  (self isMarked: objOop) ifTrue:
  [^PrimErrInappropriate].
  classIndex := self classIndexOf: objOop.
  "validate the class ref, but don't update it until any internal classes have been added to the class table."
  (classIndex anyMask: TopHashBit)
  ifTrue:
  [classIndex := classIndex - TopHashBit.
  classIndex >= numOutPointers ifTrue:
  [^PrimErrBadIndex halt].
  mappedOop := self fetchPointer: classIndex ofObject: outPointerArray.
  hash := self rawHashBitsOf: mappedOop.
  (hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = mappedOop]) ifFalse:
  [^PrimErrInappropriate halt]]
  ifFalse: "The class is contained within the segment."
  [(oop := classIndex - self firstClassIndexPun * self allocationUnit + segmentStart) >= segmentLimit ifTrue:
  [^PrimErrBadIndex halt].
  (self rawHashBitsOf: oop) ~= 0 ifTrue:
  [^PrimErrInappropriate halt]].
  0 to: (self numPointerSlotsOf: objOop) - 1 do:
  [:i|
  oop := self fetchPointer: i ofObject: objOop.
  (self isNonImmediate: oop) ifTrue:
  [(oop anyMask: TopOopBit)
  ifTrue:
  [(oop := oop - TopOopBit / self bytesPerOop) >= numOutPointers ifTrue:
  [^PrimErrBadIndex halt].
  mappedOop := self fetchPointer: oop ofObject: outPointerArray]
  ifFalse:
  [(oop bitAnd: self allocationUnit - 1) ~= 0 ifTrue:
  [^PrimErrInappropriate halt].
  (mappedOop := oop + segmentStart) >= segmentLimit ifTrue:
  [^PrimErrBadIndex halt]].
  self storePointerUnchecked: i ofObject: objOop withValue: mappedOop]].
  objOop := self objectAfter: objOop limit: segmentLimit].
  ^numSegObjs negated!

Item was changed:
  ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesIn: aCodeGen
  "infer types for untyped variables from assignments and arithmetic uses.
  For debugging answer a Dictionary from var to the nodes that determined types
  This for debugging:
  (self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
  | alreadyExplicitlyTypedOrNotToBeTyped asYetUntyped mustBeSigned newDeclarations effectiveNodes |
  aCodeGen maybeBreakForTestToInline: selector in: self.
  alreadyExplicitlyTypedOrNotToBeTyped := declarations keys asSet.
  asYetUntyped := locals copyWithoutAll: alreadyExplicitlyTypedOrNotToBeTyped.
  mustBeSigned := Set new.
  newDeclarations := Dictionary new.
  effectiveNodes := Dictionary new. "this for debugging"
  parseTree nodesDo:
  [:node| | type var |
  "If there is something of the form i >= 0, then i should be signed, not unsigned."
  (node isSend
  and: [(locals includes: (var := node receiver variableNameOrNil))
  and: [(#(<= < >= >) includes: node selector)
  and: [node args first isConstant
  and: [node args first value = 0]]]]) ifTrue:
  [mustBeSigned add: var.
  effectiveNodes at: var put: { #signed. node }, (effectiveNodes at: var ifAbsent: [#()])].
  "if an assignment to an untyped local of a known type, set the local's type to that type.
  Only observe known sends (methods in the current set) and typed local variables."
  (node isAssignment
  and: [(locals includes: (var := node variable name))
  and: [(alreadyExplicitlyTypedOrNotToBeTyped includes: var) not]]) ifTrue: "don't be fooled by previously inferred types"
  [type := node expression isSend
  ifTrue: [aCodeGen returnTypeForSend: node expression in: self ifNil: nil]
+ ifFalse: [self typeFor: (node expression isAssignment
+ ifTrue: [node expression variable]
+ ifFalse: [node expression]) in: aCodeGen].
- ifFalse: [self typeFor: node expression in: aCodeGen].
  type "If untyped, then cannot type the variable yet. A subsequent assignment may assign a subtype of what this type ends up being"
  ifNil: "Further, if the type derives from an as-yet-untyped method, we must defer."
  [alreadyExplicitlyTypedOrNotToBeTyped add: var.
  (node expression isSend
  and: [(aCodeGen methodNamed: node expression selector) notNil]) ifTrue:
  [newDeclarations removeKey: var ifAbsent: nil]]
  ifNotNil: "Merge simple types (but *don't* merge untyped vars); complex types must be defined by the programmer."
  [(aCodeGen isSimpleType: type) ifTrue:
  [(asYetUntyped includes: var)
  ifTrue: [newDeclarations at: var put: type, ' ', var. asYetUntyped remove: var]
  ifFalse:
  [aCodeGen mergeTypeOf: var in: newDeclarations with: type method: self].
  effectiveNodes at: var put: { newDeclarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]]]].
  mustBeSigned do:
  [:var|
  (newDeclarations at: var ifAbsent: nil) ifNotNil:
  [:decl| | type |
  type := aCodeGen extractTypeFor: var fromDeclaration: decl.
  type first == $u ifTrue:
  [newDeclarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var]]].
  newDeclarations keysAndValuesDo:
  [:var :decl| declarations at: var put: decl].
  ^effectiveNodes!