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

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

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

Name: VMMaker.oscog-eem.987
Author: eem
Time: 15 December 2014, 3:48:43.987 pm
UUID: 08aad1a5-4044-4aec-aecc-53c535ab4e34
Ancestors: VMMaker.oscog-eem.986

Fix generateIsIntegerObject:on:indent: for 64-bit Spur.

Make primitiveFloatAt support immedate floats.

Fix the regression of breakmnu (breakSelectorLength
must be initialized early).

Make shortPrintOop: primnt immediate floats.

Fix the stack page size for 64-bits.

Add boundary cases for isSmallFloatValue:

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

Item was changed:
  ----- Method: CCodeGenerator>>generateIsIntegerObject:on:indent: (in category 'C translation') -----
  generateIsIntegerObject: msgNode on: aStream indent: level
  "Generate the C code for this message onto the given stream."
 
+ vmClass objectMemoryClass numSmallIntegerTagBits = 1
+ ifTrue:
+ [aStream nextPutAll: '('.
+ self emitCExpression: msgNode args first on: aStream.
+ aStream nextPutAll: ' & 1)']
+ ifFalse:
+ [aStream nextPutAll: '((('.
+ self emitCExpression: msgNode args first on: aStream.
+ aStream
+ nextPutAll: ') & ';
+ print: 1 << vmClass objectMemoryClass numSmallIntegerTagBits - 1;
+ nextPutAll: ') == 1)']!
- aStream nextPutAll: '('.
- self emitCExpression: msgNode args first on: aStream.
- aStream nextPutAll: ' & 1)'.!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFloatAt (in category 'indexing primitives') -----
  primitiveFloatAt
  "Provide platform-independent access to 32-bit words comprising
  a Float.  Map index 1 onto the most significant word and index 2
  onto the least significant word."
  | rcvr index result |
  <var: #result type: #usqInt>
  self initPrimCall.
  rcvr := self stackValue: 1.
  index := self stackTop.
  index = ConstOne ifTrue:
  [result := self positive32BitIntegerFor:
+ (objectMemory
+ fetchLong32: (VMBIGENDIAN ifTrue: [0] ifFalse: [1])
+ ofFloatObject: rcvr).
- (objectMemory fetchLong32: (VMBIGENDIAN ifTrue: [0] ifFalse: [1])
- ofObject: rcvr).
  ^self pop: 2 thenPush: result].
  index = ConstTwo ifTrue:
  [result := self positive32BitIntegerFor:
+ (objectMemory
+ fetchLong32: (VMBIGENDIAN ifTrue: [1] ifFalse: [0])
+ ofFloatObject: rcvr).
- (objectMemory fetchLong32: (VMBIGENDIAN ifTrue: [1] ifFalse: [0])
- ofObject: rcvr).
  ^self pop: 2 thenPush: result].
  self primitiveFailFor: ((objectMemory isIntegerObject: index)
  ifTrue: [PrimErrBadIndex]
  ifFalse: [PrimErrBadArgument])!

Item was added:
+ ----- Method: ObjectMemory>>fetchLong32:ofFloatObject: (in category 'object access') -----
+ fetchLong32: fieldIndex ofFloatObject: oop
+ "index by word size, and return a pointer as long as the word size"
+ ^self fetchLong32: fieldIndex ofObject: oop!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>fetchLong32:ofFloatObject: (in category 'object access') -----
+ fetchLong32: fieldIndex ofFloatObject: oop
+ "index by word size, and return a pointer as long as the word size"
+ ^self fetchLong32: fieldIndex ofObject: oop!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>fetchLong32:ofFloatObject: (in category 'object access') -----
+ fetchLong32: fieldIndex ofFloatObject: oop
+ "index by word size, and return a pointer as long as the word size"
+
+ | rot |
+ (self isImmediateFloat: oop) ifFalse:
+ [^self fetchLong32: fieldIndex ofObject: oop].
+
+ rot := oop >> self numTagBits.
+ rot > 1 ifTrue:
+ [rot := rot + (self smallFloatExponentOffset << (self smallFloatMantissaBits + 1))].
+ rot := self rotateRight: rot.
+ ^self
+ cCode: [self longAt: (self cCoerceSimple: (self addressOf: rot) to: #'char *')
+ + (fieldIndex << self shiftForWord)]
+ inSmalltalk: [self flag: #endian.
+ fieldIndex = 0
+ ifTrue: [rot >> 32]
+ ifFalse: [rot bitAnd: 16rFFFFFFFF]]!

Item was added:
+ ----- Method: SpurMemoryManager>>bytesPerOop (in category 'accessing') -----
+ bytesPerOop
+ self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>fetchLong32:ofFloatObject: (in category 'object access') -----
+ fetchLong32: fieldIndex ofFloatObject: oop
+ "index by word size, and return a pointer as long as the word size"
+ ^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>logBytesPerOop (in category 'header format') -----
+ logBytesPerOop
+ self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>printFreeListHeads (in category 'debug printing') -----
+ printFreeListHeads
+ <api>
+ | expectedMask |
+ expectedMask := 0.
+ 0 to: self numFreeLists - 1 do:
+ [:i|
+ coInterpreter printHex: (freeLists at: i).
+ (freeLists at: i) ~= 0 ifTrue:
+ [expectedMask := expectedMask + (1 << i)].
+ i \\ (32 >> self logBytesPerOop) = 0
+ ifTrue: [coInterpreter cr]
+ ifFalse: [coInterpreter tab]].
+ coInterpreter
+ print: 'mask: '; printHex: freeListsMask;
+ print: ' expected: '; printHex: expectedMask;
+ cr!

Item was changed:
  ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  | vmClass |
  self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
  aCCodeGenerator
  addHeaderFile:'<stddef.h> /* for e.g. alloca */';
  addHeaderFile:'<setjmp.h>';
  addHeaderFile:'<wchar.h> /* for wint_t */';
  addHeaderFile:'"vmCallback.h"';
  addHeaderFile:'"sqMemoryFence.h"';
  addHeaderFile:'"dispdbg.h"'.
  vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
  aCCodeGenerator
  var: #interpreterProxy  type: #'struct VirtualMachine*'.
  aCCodeGenerator
  declareVar: #sendTrace type: 'volatile int';
  declareVar: #byteCount type: 'unsigned long'.
  "These need to be pointers or unsigned."
  self declareC: #(instructionPointer method newMethod)
  as: #usqInt
  in: aCCodeGenerator.
  "These are all pointers; char * because Slang has no support for C pointer arithmetic."
  self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit stackMemory breakSelector)
  as: #'char *'
  in: aCCodeGenerator.
+ aCCodeGenerator
+ var: #breakSelectorLength
+ declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
  self declareC: #(stackPage overflowedPage)
  as: #'StackPage *'
  in: aCCodeGenerator.
  aCCodeGenerator removeVariable: 'stackPages'.  "this is an implicit receiver in the translated code."
  "This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
  is not defined, for the benefit of the interpreter on slow machines."
  aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
  MULTIPLEBYTECODESETS == false ifTrue:
  [aCCodeGenerator
  removeVariable: 'extA';
  removeVariable: 'extB';
  removeVariable: 'bytecodeSetSelector'].
  aCCodeGenerator
  var: #methodCache
  declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  aCCodeGenerator
  var: #atCache
  declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'.
  aCCodeGenerator
  var: #primitiveTable
  declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
  vmClass primitiveTable do:
  [:symbolOrNot|
  (symbolOrNot isSymbol
  and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  [(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  [:tMethod| tMethod returnType: #void]]].
  vmClass objectMemoryClass hasSpurMemoryManagerAPI
  ifTrue:
  [aCCodeGenerator
  var: #primitiveAccessorDepthTable
  type: 'signed char'
  sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
  array: vmClass primitiveAccessorDepthTable]
  ifFalse:
  [aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
  aCCodeGenerator
  var: #primitiveFunctionPointer
  declareC: 'void (*primitiveFunctionPointer)()'.
  aCCodeGenerator
  var: #externalPrimitiveTable
  declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
  aCCodeGenerator var: #showSurfaceFn type: #'void *'.
  aCCodeGenerator
  var: #jmpBuf
  declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  aCCodeGenerator
  var: #suspendedCallbacks
  declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  aCCodeGenerator
  var: #suspendedMethods
  declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  aCCodeGenerator
  var: #interruptCheckChain
  declareC: 'void (*interruptCheckChain)(void) = 0'.
 
  self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
  longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
  "these are high-frequency enough that they're overflowing quite quickly on modern hardware"
  statProcessSwitch statIOProcessEvents statForceInterruptCheck
  statCheckForEvents statStackOverflow statStackPageDivorce)
  in: aCCodeGenerator.
  aCCodeGenerator var: #nextProfileTick type: #sqLong!

Item was changed:
  ----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift
  "Initialize Interpreter state before starting execution of a new image."
  interpreterProxy := self sqGetInterpreterProxy.
  self dummyReferToProxy.
  objectMemory initializeObjectMemory: bytesToShift.
  self checkAssumedCompactClasses.
  self initializeExtraClassInstVarIndices.
  method := newMethod := objectMemory nilObject.
+ self cCode: '' inSmalltalk: [breakSelectorLength := objectMemory minSmallInteger].
- breakSelectorLength := objectMemory minSmallInteger.
  methodDictLinearSearchLimit := 8.
  self flushMethodCache.
  self flushAtCache.
  self initialCleanup.
  profileSemaphore := profileProcess := profileMethod := objectMemory nilObject.
  interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  [globalSessionID = 0] whileTrue:
  [globalSessionID := self
  cCode: [(self time: #NULL) + self ioMSecs]
  inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]]!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
  shortPrintOop: oop
  <inline: false>
  self printHexnp: oop.
  (objectMemory isImmediate: oop) ifTrue:
+ [(objectMemory isIntegerObject: oop) ifTrue:
- [(objectMemory isImmediateCharacter: oop) ifTrue:
  [self
+ cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
- cCode: 'printf("=$%ld ($%lc)\n", (long)characterValueOf(oop), (wint_t)characterValueOf(oop))'
  inSmalltalk: [self print: (self shortPrint: oop); cr]].
+ (objectMemory isImmediateCharacter: oop) ifTrue:
- (objectMemory isIntegerObject: oop) ifTrue:
  [self
+ cCode: 'printf("=$%ld ($%lc)\n", (long)characterValueOf(oop), (wint_t)characterValueOf(oop))'
- cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
  inSmalltalk: [self print: (self shortPrint: oop); cr]].
+ (objectMemory isImmediateFloat: oop) ifTrue:
+ [self
+ cCode: 'printf("=%g\n", floatValueOf(oop))'
+ inSmalltalk: [self print: '='; printFloat: (objectMemory floatValueOf: oop); cr]].
  ^self].
  (objectMemory addressCouldBeObj: oop) ifFalse:
  [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  ifTrue: [' is misaligned']
  ifFalse: [self whereIs: oop]); cr].
  ((objectMemory isFreeObject: oop)
  or: [objectMemory isForwarded: oop]) ifTrue:
  [^self printOop: oop].
  self print: ': a(n) '.
  self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5.
  self cr!

Item was changed:
  ----- Method: StackInterpreter>>stackPageFrameBytes (in category 'stack pages') -----
  stackPageFrameBytes
  "Answer a byte size that accomodates a useful number of frames.
  512 bytes is room for around 40 frames a page which is a good
  compromise between overflow rate and latency in divorcing a page."
+ ^objectMemory bytesPerOop = 8
+ ifTrue: [1024]
+ ifFalse: [512]!
- ^512!

Item was changed:
  ----- Method: StackInterpreterTests>>testImmediateFloats (in category 'tests') -----
  testImmediateFloats
  "self new testImmediateFloats"
  | vm smm smallFloatOop |
  vm := StackInterpreterSimulator newWithOptions: #(ObjectMemory Spur64BitMemoryManager).
  smm := vm objectMemory.
  #(0.0 -0.0 1.0e38 -1.0e38 1.0e-38 -1.0e-38 2.0 -2.0) do:
  [:f| | sfo |
  vm initPrimCall.
  self shouldnt: [sfo := smm smallFloatObjectOf: f] raise: Error.
  self assert: (smm smallFloatValueOf: sfo) equals: f.
  self assert: ((smm exponentOfSmallFloat: sfo) between: -126 and: 127)].
+ {Float nan. Float infinity. Float negativeInfinity. 1.0e-39. 1.0e39. 5.8774717541114375e-39. 6.80564733841877e38 } do:
- {Float nan. Float infinity. Float negativeInfinity. 1.0e-39. 1.0e39 } do:
  [:f| self deny: (smm isSmallFloatValue: f)].
  vm initPrimCall.
  smallFloatOop := smm smallFloatTag + (1 << (smm smallFloatMantissaBits + smm numTagBits)).
  self shouldnt: [smm floatValueOf: smallFloatOop] raise: Error.
  self deny: vm failed.
  self assert: (smm isSmallFloatValue: (smm floatValueOf: smallFloatOop)).
  self assert: (smm floatObjectOf: (smm floatValueOf: smallFloatOop)) equals: smallFloatOop.
  vm initPrimCall.
  smallFloatOop := ((1 bitShift: 64) - 1 bitClear: (1 bitShift: smm numTagBits + 1) - 1) + smm smallFloatTag.
  self shouldnt: [smm floatValueOf: smallFloatOop] raise: Error.
  self deny: vm failed.
  self assert: (smm isSmallFloatValue: (smm floatValueOf: smallFloatOop)).
  self assert: (smm floatObjectOf: (smm floatValueOf: smallFloatOop)) equals: smallFloatOop!