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

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

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

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

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

Name: VMMaker.oscog-eem.2393
Author: eem
Time: 30 May 2018, 11:29:10.895138 am
UUID: 8860814f-14f8-4fb7-8053-5f682ed7d607
Ancestors: VMMaker.oscog-cb.2392

BitBltPlugin:
Don't fail primitiveDisplayString for empty strings (still validates fully though).

FilePlugin: Eliminate obsolete accessor (to get rid of a cCode:inSmalltalk:).

Simulation:
Allow turning off clone on GC/scavenge for speed.  On by default though.

=============== Diff against VMMaker.oscog-cb.2392 ===============

Item was changed:
  ----- Method: BitBltSimulation>>primitiveDisplayString (in category 'primitives') -----
  primitiveDisplayString
 
  | kernDelta xTable glyphMap stopIndex startIndex sourceString bbObj maxGlyph ascii glyphIndex sourcePtr left quickBlt |
  <export: true>
  <var: #sourcePtr type: 'char *'>
  interpreterProxy methodArgumentCount = 6 ifFalse:
  [^interpreterProxy primitiveFail].
  kernDelta := interpreterProxy stackIntegerValue: 0.
+ xTable := interpreterProxy stackValue: 1.
+ glyphMap := interpreterProxy stackValue: 2.
- xTable := interpreterProxy stackObjectValue: 1.
- glyphMap := interpreterProxy stackObjectValue: 2.
  stopIndex := interpreterProxy stackIntegerValue: 3.
  startIndex := interpreterProxy stackIntegerValue: 4.
+ sourceString := interpreterProxy stackValue: 5.
- sourceString := interpreterProxy stackObjectValue: 5.
  bbObj := interpreterProxy stackObjectValue: 6.
  interpreterProxy failed ifTrue:
  [^nil].
 
  ((interpreterProxy isArray: xTable)
  and: [(interpreterProxy isArray: glyphMap)
  and: [(interpreterProxy slotSizeOf: glyphMap) = 256
  and: [(interpreterProxy isBytes: sourceString)
  and: [startIndex > 0
+ and: [stopIndex >= 0 "to avoid failing for empty strings..."
- and: [stopIndex > 0
  and: [stopIndex <= (interpreterProxy byteSizeOf: sourceString)
  and: [(self loadBitBltFrom: bbObj)
  and: [combinationRule ~= 30 "these two need extra source alpha"
  and: [combinationRule ~= 31]]]]]]]]]) ifFalse:
  [^interpreterProxy primitiveFail].
+ stopIndex = 0 ifTrue:
+ [interpreterProxy pop: 6. "the string is empty; pop args, return rcvr"].
  maxGlyph := (interpreterProxy slotSizeOf: xTable) - 2.
  "See if we can go directly into copyLoopPixMap (usually we can)"
  quickBlt := destBits ~= 0 "no OS surfaces please"
  and:[sourceBits ~= 0 "and again"
  and:[noSource = false "needs a source"
  and:[sourceForm ~= destForm "no blits onto self"
  and:[cmFlags ~= 0
  or:[sourceMSB ~= destMSB
  or:[sourceDepth ~= destDepth]]]]]]. "no point using slower version"
  left := destX.
  sourcePtr := interpreterProxy firstIndexableField: sourceString.
  startIndex to: stopIndex do:[:charIndex|
  ascii := interpreterProxy byteAtPointer: sourcePtr + charIndex - 1.
  glyphIndex := interpreterProxy fetchInteger: ascii ofObject: glyphMap.
  (glyphIndex < 0 or:[glyphIndex > maxGlyph])
  ifTrue:[^interpreterProxy primitiveFail].
  sourceX := interpreterProxy fetchInteger: glyphIndex ofObject: xTable.
  width := (interpreterProxy fetchInteger: glyphIndex+1 ofObject: xTable) - sourceX.
  interpreterProxy failed ifTrue:[^nil].
  self clipRange. "Must clip here"
  (bbW > 0 and:[bbH > 0]) ifTrue: [
  quickBlt ifTrue:[
  self destMaskAndPointerInit.
  self copyLoopPixMap.
  "both, hDir and vDir are known to be > 0"
  affectedL := dx.
  affectedR := dx + bbW.
  affectedT := dy.
  affectedB := dy + bbH.
  ] ifFalse:[self copyBits]].
  interpreterProxy failed ifTrue:[^nil].
  destX := destX + width + kernDelta.
  ].
  affectedL := left.
  self showDisplayBits.
  "store destX back"
  interpreterProxy storeInteger: BBDestXIndex ofObject: bbObj withValue: destX.
+ interpreterProxy pop: 6 "pop args, return rcvr"!
- interpreterProxy pop: 6. "pop args, return rcvr"!

Item was removed:
- ----- Method: FilePlugin>>getThisSession (in category 'file primitives') -----
- getThisSession
- "Exported entry point for the VM. Only used by AsynchFilePlugin and needs to be reowrked now we have a VM global session Id capability"
- <export: true>
- ^self cCode: 'sqFileThisSession()'.!

Item was changed:
  ----- Method: NewCoObjectMemorySimulator>>fullGC (in category 'gc -- mark and sweep') -----
  fullGC
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  parent ifNil:
  [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush.
+ CloneOnGC ifTrue:
+ [coInterpreter cloneSimulation objectMemory fullGC.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory fullGC.
- Smalltalk garbageCollect].
  ^super fullGC!

Item was changed:
  ----- Method: NewCoObjectMemorySimulator>>incrementalGC (in category 'gc -- mark and sweep') -----
  incrementalGC
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  (self leakCheckNewSpaceGC
  and: [parent isNil]) ifTrue:
  [coInterpreter cr; print: 'Incremental GC number '; print: statIncrGCs; tab; flush.
+ CloneOnScavenge ifTrue:
+ [coInterpreter cloneSimulation objectMemory incrementalGC.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory incrementalGC.
- Smalltalk garbageCollect].
  ^super incrementalGC!

Item was changed:
  ----- Method: NewObjectMemorySimulator>>fullGC (in category 'gc -- mark and sweep') -----
  fullGC
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  parent ifNil:
  [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush.
+ CloneOnGC ifTrue:
+ [coInterpreter cloneSimulation objectMemory fullGC.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory fullGC.
- Smalltalk garbageCollect].
  ^super fullGC!

Item was changed:
  ----- Method: NewObjectMemorySimulator>>incrementalGC (in category 'gc -- mark and sweep') -----
  incrementalGC
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  (self leakCheckNewSpaceGC
  and: [parent isNil]) ifTrue:
  [coInterpreter cr; print: 'Incremental GC number '; print: statIncrGCs; tab; flush.
+ CloneOnScavenge ifTrue:
+ [coInterpreter cloneSimulation objectMemory incrementalGC.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory incrementalGC.
- Smalltalk garbageCollect].
  ^super incrementalGC!

Item was removed:
- ----- Method: ObjectMemory>>getHeapGrowthToSizeGCRatio (in category 'accessing') -----
- getHeapGrowthToSizeGCRatio
- "For compatibility with spur object memory"
- <option: #PharoVM>
- <returnTypeC: #float>
- ^ 0!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  parent ifNil:
  [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush.
+ CloneOnGC ifTrue:
+ [coInterpreter cloneSimulation objectMemory globalGarbageCollect.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory globalGarbageCollect.
- Smalltalk garbageCollect].
  ^super globalGarbageCollect!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>scavengingGCTenuringIf: (in category 'gc - global') -----
  scavengingGCTenuringIf: tenuringCriterion
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  (self leakCheckNewSpaceGC
  and: [parent isNil]) ifTrue:
  [coInterpreter cr; print: 'scavenge '; print: statScavenges; tab; flush.
+ CloneOnScavenge ifTrue:
+ [coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
- Smalltalk garbageCollect].
  ^super scavengingGCTenuringIf: tenuringCriterion!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
+ parent ifNil:
+ [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush.
+ CloneOnGC ifTrue:
+ [coInterpreter cloneSimulation objectMemory globalGarbageCollect.
+ Smalltalk garbageCollect]].
- "parent ifNil:
- ["coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush."
- coInterpreter cloneSimulation objectMemory globalGarbageCollect.
- Smalltalk garbageCollect]."
  ^super globalGarbageCollect!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>scavengingGCTenuringIf: (in category 'gc - global') -----
  scavengingGCTenuringIf: tenuringCriterion
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  (self leakCheckNewSpaceGC
  and: [parent isNil]) ifTrue:
  [coInterpreter cr; print: 'scavenge '; print: statScavenges; tab; flush.
+ CloneOnScavenge ifTrue:
+ [coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
- Smalltalk garbageCollect].
  ^super scavengingGCTenuringIf: tenuringCriterion!

Item was changed:
  ----- Method: Spur64BitMMLECoSimulator>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  parent ifNil:
  [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush.
+ CloneOnGC ifTrue:
+ [coInterpreter cloneSimulation objectMemory globalGarbageCollect.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory globalGarbageCollect.
- Smalltalk garbageCollect].
  ^super globalGarbageCollect!

Item was changed:
  ----- Method: Spur64BitMMLECoSimulator>>scavengingGCTenuringIf: (in category 'gc - global') -----
  scavengingGCTenuringIf: tenuringCriterion
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  (self leakCheckNewSpaceGC
  and: [parent isNil]) ifTrue:
  [coInterpreter cr; print: 'scavenge '; print: statScavenges; tab; flush.
+ CloneOnScavenge ifTrue:
+ [coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
- Smalltalk garbageCollect].
  ^super scavengingGCTenuringIf: tenuringCriterion!

Item was changed:
  ----- Method: Spur64BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  parent ifNil:
  [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush.
+ CloneOnGC ifTrue:
+ [coInterpreter cloneSimulation objectMemory globalGarbageCollect.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory globalGarbageCollect.
- Smalltalk garbageCollect].
  ^super globalGarbageCollect!

Item was changed:
  ----- Method: Spur64BitMMLESimulator>>scavengingGCTenuringIf: (in category 'gc - global') -----
  scavengingGCTenuringIf: tenuringCriterion
  "If we're /not/ a clone, clone the VM and push it over the cliff.
  If it survives, destroy the clone and continue.  We should be OK until next time."
  (self leakCheckNewSpaceGC
  and: [parent isNil]) ifTrue:
  [coInterpreter cr; print: 'scavenge '; print: statScavenges; tab; flush.
+ CloneOnScavenge ifTrue:
+ [coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
+ Smalltalk garbageCollect]].
- coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
- Smalltalk garbageCollect].
  ^super scavengingGCTenuringIf: tenuringCriterion!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  instanceVariableNames: ''
+ classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCCheckPrimCall GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM TempVectReadBarrier VMBIGENDIAN'
- classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCCheckPrimCall GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM TempVectReadBarrier VMBIGENDIAN'
  poolDictionaries: ''
  category: 'VMMaker-Interpreter'!
 
  !VMBasicConstants commentStamp: '<historical>' prior: 0!
  I am a shared pool for basic constants upon which the VM as a whole depends.
 
  self ensureClassPool.
  self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
  self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
  (ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
  [:k| self classPool declare: k from: ObjectMemory classPool]!

Item was changed:
  ----- Method: VMClass class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  "Falsify the `what type of VM is this?' flags that are defined in the various interp.h files.
  Subclass implementations need to include a super initializeMiscConstants"
 
  | omc |
  VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
  SPURVM := STACKVM := COGVM := COGMTVM := false.
 
  initializationOptions ifNil: [self initializationOptions: Dictionary new].
  omc := initializationOptions at: #ObjectMemory ifAbsent: nil.
  (omc isNil and: [self defaultObjectMemoryClass notNil]) ifTrue:
  [omc := initializationOptions at: #ObjectMemory put: self defaultObjectMemoryClass name].
  initializationOptions
  at: #SqueakV3ObjectMemory "the good ole default"
  ifAbsentPut: (omc
  ifNil: [true]
  ifNotNil: [(Smalltalk at: omc) includesBehavior: ObjectMemory]);
  at: #SpurObjectMemory "the new contender"
  ifAbsentPut: (omc
  ifNil: [false]
  ifNotNil: [(Smalltalk at: omc) includesBehavior: SpurMemoryManager]).
 
  "Use ifAbsentPut: so that they will get copied back to the
  VMMaker's options and dead code will likely be eliminated."
  PharoVM := initializationOptions at: #PharoVM ifAbsentPut: [false].
  NewspeakVM := initializationOptions at: #NewspeakVM ifAbsentPut: [false].
  SistaVM := initializationOptions at: #SistaVM ifAbsentPut: [false].
  TempVectReadBarrier := initializationOptions at: #TempVectReadBarrier ifAbsentPut: [false].
  LowcodeVM := initializationOptions at: #LowcodeVM ifAbsentPut: [false].
  MULTIPLEBYTECODESETS := initializationOptions at: #MULTIPLEBYTECODESETS ifAbsentPut: [false].
+ "Simulation only; on by default..."
+ CloneOnGC := initializationOptions at: #CloneOnGC ifAbsentPut: [true].
+ CloneOnScavenge := initializationOptions at: #CloneOnScavenge ifAbsentPut: [true].
 
  "These must be set only if specified, not defaulted, because they are set on the command line or in include files."
  initializationOptions
  at: #VMBIGENDIAN ifPresent: [:value| VMBIGENDIAN := value];
  at: #ObjectMemory ifPresent: [:value| SPURVM := value beginsWith: 'Spur'];
  at: #STACKVM ifPresent: [:value| STACKVM := value];
  at: #COGVM ifPresent: [:value| COGVM := initializationOptions at: #COGVM];
  at: #COGMTVM ifPresent: [:value| COGMTVM := initializationOptions at: #COGMTVM].
 
  "consistency checks"
  (TempVectReadBarrier and: [SPURVM not]) ifTrue: [self error: 'read barrier works with spur VM only...'].
  (SistaVM and: [SPURVM not]) ifTrue: [self error: 'Sista VM works with spur VM only...'].
  ((initializationOptions at: #compactorClass ifAbsent: []) = #SpurSelectiveCompactor and: [TempVectReadBarrier not]) ifTrue: [self error: 'Selective compactor requires read barrier'].
 
  "And not these; they're compile-time"
  IMMUTABILITY := initializationOptions at: #IMMUTABILITY ifAbsent: [SPURVM] "Default as enabled for Spur VMs"!