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

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

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

Name: VMMaker.oscog-eem.2718
Author: eem
Time: 23 February 2020, 2:11:24.545963 pm
UUID: 76bca24c-4a2d-453b-92ed-8357426d33b4
Ancestors: VMMaker.oscog-nice.2717

Cogit: don't bother to rewrite the selector in a lnked super send; this causes overwriting of the selector index in 64-bit implementations, and hence may cause an assert failure.  So it's a waste of effort and provokes an error.

Slang: type left shifts as either usqInt or sqInt, depending on type of receiver, not #int.  These are Smalltalk semantics we're trying to mimic, not C99 semantics we're constrained to follow.  better comment (and format; forgive me) generateShiftLeft:on:indent:.

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

Item was changed:
  ----- Method: CCodeGenerator>>generateShiftLeft:on:indent: (in category 'C translation') -----
  generateShiftLeft: msgNode on: aStream indent: level
+ "Generate a C bitShift.  If the receiver type is unsigned avoid C99 undefined behaviour of
+ left shifting negative values (what?!!?!!? such quiche eating idiocy to treat this like anything
+ other than a truncated left shift) by casting signed receiver types to unsigned and back.
+ If we can determine the result would overflow the word size, cast to a long integer."
- "Generate a C bitShift.  If we can determine the result
- would overflow the word size, cast to a long integer."
  | rcvr arg castToLong type mustCastBackToSign mustCastToUnsigned canSuffixTheConstant typeIsUnsigned |
  rcvr := msgNode receiver.
  arg := msgNode args first.
  castToLong := false.
  (rcvr constantNumbericValueIfAtAllPossibleOrNilIn: self) ifNotNil:
  [:rcvrVal |
  (arg constantNumbericValueIfAtAllPossibleOrNilIn: self)
  ifNil: [castToLong := vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]]
  ifNotNil:
  [:argVal |
  | valueBeyondInt |
  valueBeyondInt := 1 bitShift: 32. "The default type of const << N is int."
  castToLong := rcvrVal < valueBeyondInt
   and: [(rcvrVal bitShift: argVal) >= valueBeyondInt]]].
  canSuffixTheConstant := rcvr isConstant and: [rcvr name isEmpty and: [rcvr value >= 0]].
+ canSuffixTheConstant ifTrue:
+ [aStream nextPutAll: (self cLiteralForUnsignedInteger: rcvr value longlong: castToLong).
+ aStream nextPutAll: ' << '.
+ self emitCExpression: arg on: aStream indent: level.
+ ^self].
- canSuffixTheConstant
- ifTrue:
- [aStream nextPutAll: (self cLiteralForUnsignedInteger: rcvr value longlong: castToLong).
- aStream nextPutAll: ' << '.
- self emitCExpression: arg on: aStream indent: level.
- ^self].
  type := self typeFor: rcvr in: currentMethod.
  castToLong := castToLong and: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)].
  typeIsUnsigned := type first = $u.
  mustCastToUnsigned := typeIsUnsigned not
+ or: [castToLong
+ or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]].
- or: [castToLong
- or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]].
  mustCastBackToSign := typeIsUnsigned not.
+ mustCastBackToSign ifTrue:
+ [| promotedType |
+ promotedType := castToLong
+ ifTrue: [#sqLong]
+ ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #sqInt)
+ ifTrue: [#sqInt]
+ ifFalse: [type]].
+ aStream nextPutAll: '(('; nextPutAll: promotedType; nextPut: $)].
+ mustCastToUnsigned ifTrue:
+ [| unsigned |
+ unsigned := castToLong
+ ifTrue: [#usqLong]
+ ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
+ ifTrue: [#usqInt]
+ ifFalse: [self unsignedTypeForIntegralType: type]].
+ aStream nextPutAll: '(('; nextPutAll: unsigned; nextPutAll: ')('].
- mustCastBackToSign
- ifTrue:
- [| promotedType |
- promotedType := castToLong
- ifTrue: [#sqLong]
- ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #sqInt)
- ifTrue: [#sqInt]
- ifFalse: [type]].
- aStream nextPutAll: '(('; nextPutAll: promotedType; nextPut: $)].
- mustCastToUnsigned
- ifTrue:
- [| unsigned |
- unsigned := castToLong
- ifTrue: [#usqLong]
- ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
- ifTrue: [#usqInt]
- ifFalse: [self unsignedTypeForIntegralType: type]].
- aStream nextPutAll: '(('; nextPutAll: unsigned; nextPutAll: ')('].
  self emitCExpression: rcvr on: aStream indent: level.
  mustCastToUnsigned ifTrue: [aStream nextPut: $)].
+
+ aStream nextPutAll: ' << '.
+ self emitCExpression: arg on: aStream indent: level.
+
- aStream nextPutAll: ' << '.
- self emitCExpression: arg on: aStream indent: level.
  mustCastToUnsigned ifTrue: [aStream nextPut: $)].
  mustCastBackToSign ifTrue: [aStream nextPut: $)].!

Item was added:
+ ----- Method: CCodeGenerator>>isSignedIntegralCType: (in category 'inlining') -----
+ isSignedIntegralCType: aCType "<String>"
+ self assert: (self isIntegralCType: aCType).
+ ^aCType first ~= $u!

Item was changed:
  ----- Method: CCodeGenerator>>returnTypeForSend:in:ifNil: (in category 'type inference') -----
  returnTypeForSend: sendNode in: aTMethod ifNil: typeIfNil
  "Answer the return type for a send.  Unbound sends default to typeIfNil.
  Methods with types as yet unknown have a type determined either by the
  kernelReturnTypes or the table below, or, if they are in neither set, then nil.
  The inferred type should match as closely as possible the C type of
  generated expessions so that inlining would not change the expression.
  If there is a method for sel but its return type is as yet unknown it mustn't
  be defaulted, since on a subsequent pass its type may be computable."
  | sel methodOrNil |
  methodOrNil := self anyMethodNamed: (sel := sendNode selector).
  (methodOrNil notNil and: [methodOrNil returnType notNil]) ifTrue:
  [^self baseTypeForType: methodOrNil returnType].
  ^kernelReturnTypes
  at: sel
  ifAbsent:
  [sel
  caseOf: {
  [#integerValueOf:] -> [#sqInt].
  [#isIntegerObject:] -> [#int].
  [#negated] -> [self promoteArithmeticTypes: (sendNode receiver typeFrom: self in: aTMethod) and: #int].
  [#+] -> [self typeForArithmetic: sendNode in: aTMethod].
+ [#-] -> [self typeForArithmetic: sendNode in: aTMethod].
- [#-] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#*] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#/] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#//] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#\\] -> [self typeForArithmetic: sendNode in: aTMethod].
+ [#rem:] -> [self typeForArithmetic: sendNode in: aTMethod].
- [#rem:] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#quo:] -> [self typeForArithmetic: sendNode in: aTMethod].
+ "C99 Sec Bitwise shift operators ... 3 Semantics ...
- "C99 Sec Bitwise shift operators ... 3 Sematics ...
  The integer promotions are performed on each of the operands. The type of the result is that of the promoted left operand..."
  [#>>] -> [sendNode receiver typeFrom: self in: aTMethod].
+ [#<<] -> [(self isSignedIntegralCType: (sendNode receiver typeFrom: self in: aTMethod))
+ ifTrue: [#sqInt]
+ ifFalse: [#usqInt]].
- [#<<] -> [sendNode receiver typeFrom: self in: aTMethod].
  [#addressOf:] -> [(sendNode args first typeFrom: self in: aTMethod)
  ifNil: [#sqInt]
  ifNotNil: [:type| type, (type last isSeparator ifTrue: ['*'] ifFalse: [' *'])]].
  [#addressOf:put:] -> [(sendNode args first typeFrom: self in: aTMethod)
  ifNil: [#sqInt]
  ifNotNil: [:type| type, (type last isSeparator ifTrue: ['*'] ifFalse: [' *'])]].
  [#at:] -> [self typeForDereference: sendNode in: aTMethod].
  [#bitAnd:] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#bitOr:] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#bitXor:] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#bitClear:] -> [self typeForArithmetic: sendNode in: aTMethod].
  [#bitInvert32] -> [#'unsigned int'].
  [#bitInvert64] -> [self promoteArithmeticTypes: (sendNode receiver typeFrom: self in: aTMethod) and: #int].
  [#byteSwap32] -> [#'unsigned int'].
  [#byteSwap64] -> [#'unsigned long long'].
  [#byteSwapped32IfBigEndian:] -> [#'unsigned int'].
  [#byteSwapped64IfBigEndian:] -> [#'unsigned long long'].
  [#=] -> [#int].
  [#~=] -> [#int].
  [#==] -> [#int].
  [#~~] -> [#int].
  [#<] -> [#int].
  [#<=] -> [#int].
  [#>] -> [#int].
  [#>=] -> [#int].
  [#between:and:] -> [#int].
  [#anyMask:] -> [#int].
  [#allMask:] -> [#int].
  [#noMask:] -> [#int].
  [#isNil] -> [#int].
  [#notNil] -> [#int].
  [#&] -> [#int].
  [#|] -> [#int].
  [#not] -> [#int].
  [#asFloat] -> [#double].
  [#atan] -> [#double].
  [#exp] -> [#double].
  [#log] -> [#double].
  [#sin] -> [#double].
  [#sqrt] -> [#double].
  [#asLong] -> [#long].
  [#asInteger] -> [#sqInt].
  [#asIntegerPtr] -> [#'sqIntptr_t'].
  [#asUnsignedInteger] -> [#usqInt].
  [#asUnsignedIntegerPtr]-> [#'usqIntptr_t'].
  [#asUnsignedLong] -> [#'unsigned long'].
  [#asUnsignedLongLong] -> [#'unsigned long long'].
  [#asVoidPointer] -> [#'void *'].
  [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
  [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
  [#cCoerce:to:] -> [self conventionalTypeForType: sendNode args last value].
  [#cCoerceSimple:to:] -> [self conventionalTypeForType: sendNode args last value].
  [#sizeof:] -> [#'usqIntptr_t']. "Technically it's a size_t but it matches on target architectures so far..."
  [#ifTrue:ifFalse:] -> [self typeForConditional: sendNode in: aTMethod].
  [#ifFalse:ifTrue:] -> [self typeForConditional: sendNode in: aTMethod].
  [#ifTrue:] -> [self typeForConditional: sendNode in: aTMethod].
  [#ifFalse:] -> [self typeForConditional: sendNode in: aTMethod].
  [#and:] -> [#sqInt].
  [#or:] -> [#sqInt].
  [#caseOf:] -> [self typeFor: sendNode args first in: aTMethod] }
  otherwise: "If there /is/ a method for sel but its return type is as yet unknown it /mustn't/ be defaulted,
  since on a subsequent pass its type may be computable.  Only default unbound selectors."
  [methodOrNil ifNotNil: [nil] ifNil: [typeIfNil]]]!

Item was changed:
  ----- Method: Cogit>>linkSendAt:in:to:offset:receiver: (in category 'in-line cacheing') -----
  linkSendAt: callSiteReturnAddress in: sendingMethod to: targetMethod offset: theEntryOffset receiver: receiver
  <api>
  <var: #sendingMethod type: #'CogMethod *'>
  <var: #targetMethod type: #'CogMethod *'>
+ | inlineCacheTag extent |
- | inlineCacheTag address extent |
  self assert: (theEntryOffset = cmEntryOffset or: [theEntryOffset = cmNoCheckEntryOffset]).
  self assert: (callSiteReturnAddress between: methodZoneBase and: methodZone freeStart).
+ theEntryOffset = cmNoCheckEntryOffset
+ ifTrue: "no need to change selector cache tag"
+ [extent := backEnd rewriteCallAt: callSiteReturnAddress target: targetMethod asInteger + cmNoCheckEntryOffset]
+ ifFalse:
+ [inlineCacheTag := objectRepresentation inlineCacheTagForInstance: receiver.
+ (self inlineCacheTagsAreIndexes not and: [objectRepresentation inlineCacheTagIsYoung: inlineCacheTag]) ifTrue:
+ [methodZone ensureInYoungReferrers: sendingMethod].
+ extent := backEnd
+ rewriteInlineCacheAt: callSiteReturnAddress
+ tag: inlineCacheTag
+ target: targetMethod asInteger + theEntryOffset].
- inlineCacheTag := theEntryOffset = cmNoCheckEntryOffset
- ifTrue: [targetMethod selector "i.e. no change"]
- ifFalse: [objectRepresentation inlineCacheTagForInstance: receiver].
- (objectRepresentation inlineCacheTagIsYoung: inlineCacheTag) ifTrue:
- [methodZone ensureInYoungReferrers: sendingMethod].
- address := targetMethod asInteger + theEntryOffset.
- extent := backEnd
- rewriteInlineCacheAt: callSiteReturnAddress
- tag: inlineCacheTag
- target: address.
  backEnd
  flushICacheFrom: callSiteReturnAddress asUnsignedInteger  - extent
  to: callSiteReturnAddress asUnsignedInteger !