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

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

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

Name: VMMaker.oscog-eem.2215
Author: eem
Time: 18 May 2017, 9:20:11.128923 am
UUID: 832c8202-ffb4-43ed-9f41-9c6d2e2bf80c
Ancestors: VMMaker.oscog-nice.2214

Slang/FilePlugin:
Avoid remapping oops on creating directory entries in the FilePlugin on Spur by using remapOop:in:.  Change Slang to avoid creating nested #if-#else-#endif structures for nested remapOop:in:'s.  Nuke an unused configuration.

Spur:
Never inline objectsReachableFromRoots:.  Fix a speeling rorre.

=============== Diff against VMMaker.oscog-nice.2214 ===============

Item was changed:
  ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'directory primitives') -----
  makeDirEntryName: entryName size: entryNameSize
  createDate: createDate modDate: modifiedDate
+ isDir: dirFlag fileSize: fileSize
+ <var: 'entryName' type: #'char *'>
+ <var: 'fileSize' type: #squeakFileOffsetType>
- isDir: dirFlag fileSize: fileSize
-
  | modDateOop createDateOop nameString results stringPtr fileSizeOop |
+ <var: 'stringPtr' type: #'char *'>
- <var: 'entryName' type: 'char *'>
- <var: 'stringPtr' type:'char *'>
- <var: 'fileSize' type:'squeakFileOffsetType '>
 
  "allocate storage for results, remapping newly allocated
+ oops if required in case GC happens during allocation"
+ results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 5.
+ self remapOop: results in:
+ [nameString := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: entryNameSize.
+ self remapOop: nameString in:
+ [createDateOop := interpreterProxy positive32BitIntegerFor: createDate.
+ self remapOop: createDateOop in:
+ [modDateOop := interpreterProxy positive32BitIntegerFor: modifiedDate.
+ self remapOop: modDateOop in:
+ [fileSizeOop := interpreterProxy positive64BitIntegerFor: fileSize]]]].
- oops in case GC happens during allocation"
- interpreterProxy pushRemappableOop:
- (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: createDate).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: modifiedDate).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive64BitIntegerFor: fileSize).
 
- results := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 5.
-
- fileSizeOop := interpreterProxy popRemappableOop.
- modDateOop := interpreterProxy popRemappableOop.
- createDateOop := interpreterProxy popRemappableOop.
- nameString := interpreterProxy popRemappableOop.
-
  "copy name into Smalltalk string"
  stringPtr := interpreterProxy firstIndexableField: nameString.
  0 to: entryNameSize - 1 do:
  [ :i |
  self cCode: [stringPtr at: i put: (entryName at: i)]
  inSmalltalk: [interpreterProxy storeByte: i ofObject: nameString withValue: (entryName at: i+1) asciiValue]].
 
  interpreterProxy
  storePointer: 0 ofObject: results withValue: nameString;
  storePointer: 1 ofObject: results withValue: createDateOop;
  storePointer: 2 ofObject: results withValue: modDateOop;
  storePointer: 3 ofObject: results withValue: (dirFlag
  ifTrue: [interpreterProxy trueObject]
  ifFalse: [interpreterProxy falseObject]);
  storePointer: 4 ofObject: results withValue: fileSizeOop.
  ^results!

Item was changed:
  ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'directory primitives') -----
  makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize posixPermissions: posixPermissions isSymlink: symlinkFlag
+ <var: 'entryName' type: #'char *'>
+ <var: 'fileSize' type: #squeakFileOffsetType>
- <var: 'entryName' type: 'char *'>
- <var: 'fileSize' type: 'squeakFileOffsetType '>
  <option: #PharoVM>
-
  | modDateOop createDateOop nameString results stringPtr posixPermissionsOop fileSizeOop |
+ <var: 'stringPtr' type: #'char *'>
- <var: 'stringPtr' type: 'char *'>
 
  "allocate storage for results, remapping newly allocated
+ oops if required in case GC happens during allocation"
+ results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 7.
+ self remapOop: results in:
+ [nameString := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: entryNameSize.
+ self remapOop: nameString in:
+ [createDateOop := interpreterProxy positive32BitIntegerFor: createDate.
+ self remapOop: createDateOop in:
+ [modDateOop := interpreterProxy positive32BitIntegerFor: modifiedDate.
+ self remapOop: modDateOop in:
+ [fileSizeOop := interpreterProxy positive64BitIntegerFor: fileSize.
+ self remapOop: fileSizeOop in:
+ [posixPermissionsOop := interpreterProxy positive32BitIntegerFor: posixPermissions]]]]].
- oops in case GC happens during allocation"
- interpreterProxy pushRemappableOop:
- (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 7).
- interpreterProxy pushRemappableOop:
- (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: createDate).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: modifiedDate).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive64BitIntegerFor: fileSize).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: posixPermissions).
 
- posixPermissionsOop := interpreterProxy popRemappableOop.
- fileSizeOop := interpreterProxy popRemappableOop.
- modDateOop := interpreterProxy popRemappableOop.
- createDateOop := interpreterProxy popRemappableOop.
- nameString  := interpreterProxy popRemappableOop.
- results := interpreterProxy popRemappableOop.
-
  "copy name into Smalltalk string"
  stringPtr := interpreterProxy firstIndexableField: nameString.
+ 0 to: entryNameSize - 1 do:
+ [ :i |
+ self cCode: [stringPtr at: i put: (entryName at: i)]
+ inSmalltalk: [interpreterProxy storeByte: i ofObject: nameString withValue: (entryName at: i+1) asciiValue]].
- 0 to: entryNameSize - 1 do: [ :i |
- stringPtr at: i put: (entryName at: i).
- ].
 
+ interpreterProxy
+ storePointer: 0 ofObject: results withValue: nameString;
+ storePointer: 1 ofObject: results withValue: createDateOop;
+ storePointer: 2 ofObject: results withValue: modDateOop;
+ storePointer: 3 ofObject: results withValue: (dirFlag
+ ifTrue: [interpreterProxy trueObject]
+ ifFalse: [interpreterProxy falseObject]);
+ storePointer: 4 ofObject: results withValue: fileSizeOop;
+ storePointer: 5 ofObject: results withValue: posixPermissionsOop;
+ storePointer: 6 ofObject: results withValue: (symlinkFlag
+ ifTrue: [interpreterProxy trueObject]
+ ifFalse: [interpreterProxy falseObject]).
+ ^results!
- interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
- interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
- interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
- dirFlag
- ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
- ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
- interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
- interpreterProxy storePointer: 5 ofObject: results withValue: posixPermissionsOop.
- symlinkFlag
- ifTrue: [ interpreterProxy storePointer:  6 ofObject: results withValue: interpreterProxy trueObject ]
- ifFalse: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy falseObject ].
- ^ results!

Item was changed:
  ----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') -----
  objectsReachableFromRoots: arrayOfRoots
  "This is part of storeImageSegmentInto:outPointers:roots:.
  Answer an Array of all the objects only reachable from the argument, an Array of root objects,
  starting with arrayOfRoots.  If there is no space, answer a SmallInteger whose value is the
  number of slots required.  This is used to collect the objects to include in an image segment
  on Spur, separate from creating the segment, hence simplifying the implementation.
  Thanks to Igor Stasenko for this idea."
 
  | freeChunk ptr start limit count oop objOop |
+ <inline: #never>
  self assert: (self isArray: arrayOfRoots).
  "Mark all objects except those only reachable from the arrayOfRoots by marking
  each object in arrayOfRoots and then marking all reachable objects (from the
  system roots).  This leaves unmarked only objects reachable from the arrayOfRoots.
  N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed."
    self assert: self allObjectsUnmarked.
  self markObjectsIn: arrayOfRoots.
  self markObjects: false.
 
  "After the mark phase all unreachable weak slots will have been nilled
  and all active ephemerons fired."
  self assert: (self isEmptyObjStack: markStack).
  self assert: (self isEmptyObjStack: weaklingStack).
  self assert: self noUnscannedEphemerons.
 
  "Use the largest free chunk to answer the result."
  freeChunk := self allocateLargestFreeChunk.
  ptr := start := freeChunk + self baseHeaderSize.
  limit := self addressAfter: freeChunk.
  count := 0.
 
  "First put the arrayOfRoots; order is important."
  count := count + 1.
  ptr < limit ifTrue:
  [self longAt: ptr put: arrayOfRoots.
  ptr := ptr + self bytesPerOop].
 
  0 to: (self numSlotsOf: arrayOfRoots) - 1 do:
  [:i|
  oop := self fetchPointer: i ofObject: arrayOfRoots.
  (self isNonImmediate: oop) ifTrue:
  [self noCheckPush: oop onObjStack: markStack]].
 
  "Now collect the unmarked objects reachable from the roots."
  [self isEmptyObjStack: markStack] whileFalse:
  [objOop := self popObjStack: markStack.
  count := count + 1.
  ptr < limit ifTrue:
  [self longAt: ptr put: objOop.
  ptr := ptr + self bytesPerOop].
  oop := self fetchClassOfNonImm: objOop.
  (self isMarked: oop) ifFalse:
  [self setIsMarkedOf: objOop to: true.
  self noCheckPush: oop onObjStack: markStack].
  ((self isContextNonImm: objOop)
   and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the loop"
  ifTrue:
  [0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do:
  [:i|
  oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
  ((self isImmediate: oop)
   or: [self isMarked: oop]) ifFalse:
  [self setIsMarkedOf: objOop to: true.
  self noCheckPush: oop onObjStack: markStack]]]
  ifFalse:
  [0 to: (self numPointerSlotsOf: objOop) - 1 do:
  [:i|
  oop := self fetchPointer: i ofObject: objOop.
  ((self isImmediate: oop)
   or: [self isMarked: oop]) ifFalse:
  [self setIsMarkedOf: objOop to: true.
  self noCheckPush: oop onObjStack: markStack]]]].
 
  self unmarkAllObjects.
 
  totalFreeOldSpace := totalFreeOldSpace - (self bytesInObject: freeChunk).
  "Now try and allocate the result"
  (count > (ptr - start / self bytesPerOop) "not enough room"
  or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  [self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
  self checkFreeSpace: GCModeImageSegment.
  ^self integerObjectOf: count].
  "There's room; set the format, & classIndex and shorten."
  self setFormatOf: freeChunk to: self arrayFormat.
  self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
  self shorten: freeChunk toIndexableSize: count.
  (self isForwarded: freeChunk) ifTrue:
  [freeChunk := self followForwarded: freeChunk].
  self possibleRootStoreInto: freeChunk.
  self checkFreeSpace: GCModeImageSegment.
  self runLeakCheckerFor: GCModeImageSegment.
  ^freeChunk!

Item was changed:
  ----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') -----
  storeImageSegmentInto: segmentWordArrayArg outPointers: outPointerArrayArg roots: arrayOfRootsArg
  "This primitive is called from Squeak as...
  <imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray.
 
  This primitive will store a binary image segment (in the same format as objects in the heap) of the
  set of objects in arrayOfObjects.  All pointers from within the set to objects outside the set will be
  copied into the array of outPointers.  In their place in the image segment will be an oop equal to the
  offset in the outPointer array (the first would be 8), but with the high bit set.
 
  Since Spur has a class table the load primitive must insert classes that have instances into the
  class table.  This primitive marks such classes using the isRemembered bit, which isn't meaningful
  as a remembered bit in the segment.
 
  The primitive expects the segmentWordArray and outPointerArray to be more than adequately long.
  In this case it returns normally, and truncates the two arrays to exactly the right size.
 
  The primitive can fail for the following reasons with the specified failure codes:
  PrimErrGenericError: the segmentWordArray is too small for the version stamp
  PrimErrWritePastObject: the segmentWordArray is too small to contain the reachable objects
  PrimErrBadIndex: the outPointerArray is too small
  PrimErrNoMemory: additional allocations failed
  PrimErrLimitExceeded: there is no room in the hash field to store out pointer indices or class references."
  <inline: false>
  | segmentWordArray outPointerArray arrayOfRoots
   arrayOfObjects savedFirstFields savedOutHashes segStart segAddr endSeg outIndex numClassesInSegment |
  ((self isObjImmutable: segmentWordArrayArg)
  or: [self isObjImmutable: outPointerArrayArg]) ifTrue:
  [^PrimErrNoModification].
  "Since segmentWordArrayArg & outPointerArrayArg may get shortened, they can't be pinned."
  ((self isPinned: segmentWordArrayArg)
  or: [self isPinned: outPointerArrayArg]) ifTrue:
  [^PrimErrObjectIsPinned].
  (self numSlotsOf: outPointerArrayArg) > self maxIdentityHash ifTrue:
  [^PrimErrLimitExceeded].
 
  self runLeakCheckerFor: GCModeImageSegment.
 
+ "First scavenge to collect any new space garbage that refers to the graph."
- "First scavenge to coillect any new space garbage that refers to the graph."
  self scavengingGC.
  segmentWordArray := self updatePostScavenge: segmentWordArrayArg.
  outPointerArray := self updatePostScavenge: outPointerArrayArg.
  arrayOfRoots := self updatePostScavenge: arrayOfRootsArg.
 
  "Now compute the transitive closure, collecting the sequence of objects to be stored in the arrayOfObjects array.
  Included in arrayOfObjects are the arrayOfRoots and all its contents.  All objects have been unmarked."
  arrayOfObjects := self objectsReachableFromRoots: arrayOfRoots.
  arrayOfObjects ifNil:
  [^PrimErrNoMemory].
 
  self assert: self allObjectsUnmarked. "work to be done when the incremental GC is written"
 
  "Both to expand the max size of segment and to reduce the length of the
  load-time pass that adds classes to the class table, move classes to the
  front of arrayOfObjects, leaving the root array as the first element."
  numClassesInSegment := self moveClassesForwardsIn: arrayOfObjects.
 
  "The scheme is to copy the objects into segmentWordArray, and then map the oops in segmentWordArray.
  Therefore the primitive needs to both map efficiently originals to copies in segmentWordArray and
  be able to undo any side-effects if the primitive fails because either segmentWordArray or outPointerArray
  is too small.  The mapping is done by having the objects to be stored in arrayOfObjects refer to their mapped
  locations through their first field, just like a forwarding pointer, but without becoming a forwarder, saving their
  first field in savedFirstFields, and the objects in outPointerArray pointing to tehir locations in the outPointerArray
  through their identityHashes, saved in savedOutHashes.
  Since arrayOfObjects and its savedFirstFields, and outPointerArray and its saved hashes, can be enumerated
  side-by-side, the hashes can be restored to the originals.  So the hash of an object in arrayOfObjects
  is set to its offset in segmentWordArray / self allocationUnit, and the hash of an object in outPointerArray
  is set to its index in outPointerArray plus the top hash bit.  Oops in segmentWordArray are therefore
  mapped by accessing the original oop's identityHash, testing the bottom bit to distinguish between internal
  and external oops.  The saved hash arrays are initialized with an out-of-range hash value so that the first
  unused entry can be identified."
 
  savedFirstFields := self allocateSlots: (self numSlotsOf: arrayOfObjects)
  format: self wordIndexableFormat
  classIndex: self wordSizeClassIndexPun.
  savedOutHashes := self allocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4)
  format: self firstLongFormat
  classIndex: self thirtyTwoBitLongsClassIndexPun.
  (savedFirstFields isNil or: [savedOutHashes isNil]) ifTrue:
  [self freeObject: arrayOfObjects.
  ^PrimErrNoMemory].
 
  self fillObj: savedFirstFields numSlots: (self numSlotsOf: savedFirstFields) with: 0.
  self fillObj: savedOutHashes numSlots: (self numSlotsOf: savedOutHashes) with: self savedOutHashFillValue.
 
  segAddr := segmentWordArray + self baseHeaderSize.
  endSeg := self addressAfter: segmentWordArray.
 
  "Write a version number for byte order and version check."
  segAddr >= endSeg ifTrue: [^PrimErrGenericFailure].
  self long32At: segAddr put: self imageSegmentVersion.
  self long32At: segAddr + 4 put: self imageSegmentVersion.
  segStart := segAddr := segAddr + self allocationUnit.
 
  "Copy all reachable objects to the segment, setting the marked bit for all objects (clones) in the segment,
  and the remembered bit for all classes (clones) in the segment."
  0 to: (self numSlotsOf: arrayOfObjects) - 1 do:
  [:i| | newSegAddrOrError objOop |
  "Check that classes in the segment are addressible.  Since the top bit of the hash field is used to tag
  classes external to the segment, the segment offset must not inadvertently set this bit.  This limit still
  allows for a million or more classes."
  (i = numClassesInSegment
  and: [segAddr - segStart / self allocationUnit + self lastClassIndexPun >= TopHashBit]) ifTrue:
  [^self return: PrimErrLimitExceeded
  restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields
  and: outPointerArray savedHashes: savedOutHashes].
  objOop := self fetchPointer: i ofObject: arrayOfObjects.
  self deny: ((self isImmediate: objOop) or: [self isForwarded: objOop]).
  newSegAddrOrError := self copyObj: objOop toAddr: segAddr startAt: segStart stopAt: endSeg savedFirstFields: savedFirstFields index: i.
  newSegAddrOrError < segStart ifTrue:
  [^self return: newSegAddrOrError
  restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields
  and: outPointerArray savedHashes: savedOutHashes].
  segAddr := newSegAddrOrError].
 
  "Check that it can be safely shortened."
  (endSeg ~= segAddr
  and: [endSeg - segAddr < (self baseHeaderSize + self bytesPerOop)]) ifTrue:
  [^self return: PrimErrWritePastObject
  restoringObjectsIn: arrayOfObjects upTo: -1 savedFirstFields: savedFirstFields
  and: outPointerArray savedHashes: savedOutHashes].
 
  "Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
  have their first field pointing to the corresponding copy in segmentWordArray."
  (outIndex := self mapOopsFrom: segStart
  to: segAddr
  outPointers: outPointerArray
  outHashes: savedOutHashes) < 0 ifTrue: "no room in outPointers; fail"
  [^self return: PrimErrBadIndex
  restoringObjectsIn: arrayOfObjects upTo: -1 savedFirstFields: savedFirstFields
  and: outPointerArray savedHashes: savedOutHashes].
 
  "We're done.  Shorten the results, restore hashes and return."
  self shorten: segmentWordArray toIndexableSize: segAddr - (segmentWordArray + self baseHeaderSize) / 4.
  self shorten: outPointerArray toIndexableSize: outIndex.
  ^self return: PrimNoErr
  restoringObjectsIn: arrayOfObjects upTo: -1 savedFirstFields: savedFirstFields
  and: outPointerArray savedHashes: savedOutHashes!

Item was removed:
- ----- Method: VMMaker class>>generateSqueakSpurStackSistaVM (in category 'configurations') -----
- generateSqueakSpurStackSistaVM
- "No primitives since we can use those for the Cog VM"
- ^VMMaker
- generate: StackInterpreter
- with: #(SistaVM true
- ObjectMemory Spur32BitMemoryManager
- FailImbalancedPrimitives false
- MULTIPLEBYTECODESETS true
- bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
- to: (FileDirectory default pathFromURI: self sourceTree, '/spursistastacksrc')
- platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
- including:#()!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>generateRemapOopIn:on:indent: (in category 'C translation') -----
  generateRemapOopIn: aNode on: aStream indent: level
  "Generate the C code for this message onto the given stream."
+ | arm |
+ "Avoid nesting #if SPURVM...#else...#endif within arms of an outer #if SPURVM...#else...#endif."
+ (Notification new tag: #inRemapOopInArm; signal) ifNotNil:
+ [:inRemapOopInArm|
+ ^inRemapOopInArm
+ ifTrue: [self generateSpurRemapOopIn: aNode on: aStream indent: level]
+ ifFalse: [self generateV3RemapOopIn: aNode on: aStream indent: level]].
+ [aStream cr; nextPutAll: '#if SPURVM'; cr.
+ arm := true.
+ self generateSpurRemapOopIn: aNode on: aStream indent: level.
+ aStream cr; nextPutAll: '#else /* SPURVM */'; cr.
+ arm := false.
+ self generateV3RemapOopIn: aNode on: aStream indent: level.
+ aStream cr; nextPutAll: '#endif /* SPURVM */'; cr]
+ on: Notification
+ do: [:ex|
+ ex tag == #inRemapOopInArm
+ ifTrue: [ex resume: arm]
+ ifFalse: [ex pass]]!
-
- aStream cr; nextPutAll: '#if SPURVM'; cr.
- self generateSpurRemapOopIn: aNode on: aStream indent: level.
- aStream cr; nextPutAll: '#else /* SPURVM */'; cr.
- self generateV3RemapOopIn: aNode on: aStream indent: level.
- aStream cr; nextPutAll: '#endif /* SPURVM */'; cr!