[Vm-dev] VM Maker: VMMaker.oscog-eem.3143.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Feb 4 07:01:44 UTC 2022
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3143.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3143
Author: eem
Time: 3 February 2022, 11:01:26.92225 pm
UUID: b38b27b8-2e0e-4b1b-9eef-dfa1e6b19d78
Ancestors: VMMaker.oscog-eem.3142
CoInterpreter: ceNewArraySlotSize: is V3 only; delete Spur-specific code. Fix pinning logic in
Slang: fix generation for flagsPtr arg of functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: being nil
Simulation: fix several issues simulating the FFI test suite, especially around using memcpy to copy float values. Fix the stack depth check in ceSendAbort:to:numArgs:. Fix simulation of findEmptySegNearestInSizeTo:. Nuke CogVMSimulator>>ceSendMustBeBoolean: which just halted.
"Nothing more expected ->"
=============== Diff against VMMaker.oscog-eem.3142 ===============
Item was changed:
----- Method: CCodeGenerator>>nilOrBooleanConstantReceiverOf: (in category 'utilities') -----
nilOrBooleanConstantReceiverOf: aNode
"Answer nil or the boolean constant that is the receiver of the given message send.
Used to suppress conditional code when the condition is a translation-time constant."
| val receiver argument arms |
generateDeadCode ifTrue:[^nil].
((self isConstantNode: aNode valueInto: [:v| val := v])
and: [#(true false) includes: val]) ifTrue:
[^val].
aNode isSend ifTrue:
[aNode selector == #not ifTrue:
[(self nilOrBooleanConstantReceiverOf: aNode receiver) ifNotNil:
[:bool| ^bool not]].
((#(isNil notNil) includes: aNode selector)
and: [self isNilConstantReceiverOf: aNode]) ifTrue:
[^aNode selector == #isNil].
((#(or: and:) includes: aNode selector)
and: [aNode args last isStmtList
and: [aNode args last statements size = 1]]) ifTrue:
[(self nilOrBooleanConstantReceiverOf: aNode receiver) ifNotNil:
[:rcvr|
((rcvr == false and: [aNode selector == #and:])
or: [rcvr == true and: [aNode selector == #or:]]) ifTrue:
[^rcvr].
(self nilOrBooleanConstantReceiverOf: aNode args last statements first) ifNotNil:
[:arg|
^rcvr perform: aNode selector with: [arg]]].
"We can also eliminate expr and: [false], expr or: [true], but only if expr is side-effect free.
This is a weak test; we don't traverse calls. Caveat emptor!!"
((aNode receiver noneSatisfy: [:node| node isAssignment]) "No side-effects in the elided expression"
and: [aNode args last statements size = 1]) ifTrue:
[(self nilOrBooleanConstantReceiverOf: aNode args last statements first) ifNotNil:
[:arg|
((arg == false and: [aNode selector == #and:])
or: [arg == true and: [aNode selector == #or:]]) ifTrue:
[^arg]]]].
"Look for Const ifTrue: [self foo] ifFalse: [false] => false"
((#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: aNode selector)
and: [(self isConstantNode: aNode receiver valueInto: [:v| val := v])
and: [(#(true false) includes: val)
and: [arms := aNode args collect:
[:altBlock| | bval |
(altBlock statements size = 1
and: [(self isConstantNode: altBlock statements last valueInto: [:v| bval := v])
and: [#(true false) includes: bval]]) ifTrue:
[bval]].
arms asArray ~= #(nil nil)]]]) ifTrue:
[| arm |
arm := aNode selector == #ifTrue:ifFalse: == val
ifTrue: [arms first]
ifFalse: [arms last].
(#(true false) includes: arm) ifTrue:
[^arm]].
((#(= ~= < > <= >=) includes: aNode selector)
and: [(self isConstantNode: aNode receiver valueInto: [:v| receiver := v])
and: [receiver isInteger
and: [(self isConstantNode: aNode args first valueInto: [:v| argument := v])
and: [argument isInteger]]]]) ifTrue:
[^receiver perform: aNode selector with: argument].
"Inlining for e.g. CharacterTable ifNil: [...] ifNotNil: [...]], which compiles to CharacterTable == nil ifTrue: [...] ifFalse: [...]"
(aNode selector == #==
+ and: [aNode args first isNilNode
+ and: [aNode receiver isNilNode]]) ifTrue:
- and: [aNode args first isVariable
- and: [aNode args first name = 'nil'
- and: [aNode receiver isConstant
- and: [aNode receiver value == nil]]]]) ifTrue:
[^true]].
^nil!
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].
[#rem:] -> [self typeForArithmetic: sendNode in: aTMethod].
[#quo:] -> [self typeForArithmetic: sendNode in: aTMethod].
"C99 Sec Bitwise shift operators ... 3 Semantics ...
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]].
[#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].
+ [#mod:f:] -> [#double].
[#asLong] -> [#long].
[#asInteger] -> [#sqInt].
[#asIntegerPtr] -> [#'sqIntptr_t'].
[#asUnsignedInteger] -> [#usqInt].
[#asUnsignedIntegerPtr]-> [#'usqIntptr_t'].
[#asUnsignedLong] -> [#'unsigned long'].
[#asUnsignedLongLong] -> [#'unsigned long long'].
[#asVoidPointer] -> [#'void *'].
[#signedIntFromLong] -> [#int]. "c.f. generateSignedIntFromLong:on:indent:"
[#signedIntFromLong64] -> [#sqInt]. "c.f. generateSignedIntFromLong64:on:indent: N.B. not written to answer sqLong because only used in 64-bit realm"
[#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
[#signedIntToLong64] -> [#usqInt]. "c.f. generateSignedIntToLong64: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: CoInterpreter>>ceNewArraySlotSize: (in category 'trampolines') -----
ceNewArraySlotSize: slotSize
<api>
<option: #SqueakV3ObjectMemory>
- objectMemory hasSpurMemoryManagerAPI ifTrue:
- [| obj |
- obj := objectMemory
- eeInstantiateSmallClassIndex: ClassArrayCompactIndex
- format: objectMemory arrayFormat
- numSlots: slotSize.
- objectMemory fillObj: obj numSlots: slotSize with: objectMemory nilObject.
- ^obj].
^objectMemory
eeInstantiateAndInitializeClass: (objectMemory splObj: ClassArray)
indexableSize: slotSize!
Item was changed:
----- Method: CogVMSimulator>>ceSendAbort:to:numArgs: (in category 'trampolines') -----
ceSendAbort: selector to: rcvr numArgs: numArgs
"self stringOf: selector"
"self printOop: rcvr"
self logSend: selector.
cogit assertCStackWellAligned.
+ self maybeCheckStackDepth: numArgs + 2 "receiver, args & instructionPointer are all pushed..."
- self maybeCheckStackDepth: numArgs + 1
sp: stackPointer
pc: (stackPages longAt: stackPointer).
^super ceSendAbort: selector to: rcvr numArgs: numArgs!
Item was removed:
- ----- Method: CogVMSimulator>>ceSendMustBeBoolean: (in category 'trampolines') -----
- ceSendMustBeBoolean: anObject
- self halt.
- ^super ceSendMustBeBoolean: anObject!
Item was changed:
----- Method: CogVMSimulator>>mapFunctionToAddress: (in category 'cog jit support') -----
mapFunctionToAddress: aSymbolOrIndexOrBlock
"Hackery to deal with the plugin primitive simulation hoops.
aSymbolOrIndex is either a Symbol (#primitiveExternalCall) or an
index above 1001 (an index + 1000 into the externalPrimitiveTable)."
| sobui symbolOrBlock |
aSymbolOrIndexOrBlock = 0 ifTrue: [^0].
self assert: (aSymbolOrIndexOrBlock isSymbol
or: [aSymbolOrIndexOrBlock isBlock
or: [aSymbolOrIndexOrBlock isInteger
+ and: [(aSymbolOrIndexOrBlock between: 1001 and: 2000)
+ or: [aSymbolOrIndexOrBlock > 0 and: [aSymbolOrIndexOrBlock = primitiveCalloutPointer]]]]]).
- and: [aSymbolOrIndexOrBlock between: 1001 and: 2000]]]).
symbolOrBlock := aSymbolOrIndexOrBlock isInteger
ifTrue: [(self pluginEntryFor: aSymbolOrIndexOrBlock) at: 3]
ifFalse: [aSymbolOrIndexOrBlock].
uniqueIndices ifNil:
[uniqueIndices := Dictionary new.
uniqueIndex := 65535].
sobui := uniqueIndices at: symbolOrBlock ifAbsentPut: [uniqueIndex := uniqueIndex + 1].
^cogit
mapPrimitive: symbolOrBlock
withIndexToUniqueAddress: sobui!
Item was changed:
----- Method: CogVMSimulator>>primitivePerform (in category 'debugging traps') -----
primitivePerform
+ "Add a filter to perform to allow hacking of startup sequences in the simulator, eliding modules that can't yet be simulated."
| receiver selector |
+ receiver := self stackValue: argumentCount.
- "If called from the machine code perform primitive, it should not have been found,
- except that the cacheing for V3 has a mismatch between that used ror the first-level
- method cache and inline caches."
- receiver := (self stackValue: argumentCount).
selector := self stackValue: argumentCount - 1.
+ "If called from the machine code perform primitive, the message should not have been found in the cache,
+ except that V3 has a mismatch between keys used for the first-level method cache and inline caches."
((self methodHasCogMethod: newMethod)
and: [(objectMemory isCompactInstance: receiver) not]) ifTrue:
[self deny: (self newMethodInLookupCacheAt: selector and: (objectMemory fetchClassTagOf: receiver))].
self sendBreakpoint: selector receiver: receiver.
(self filterPerformOf: selector to: receiver) ifTrue:
[^self pop: argumentCount].
^super primitivePerform!
Item was changed:
----- Method: Integer>>coerceTo:sim: (in category '*VMMaker-interpreter simulator') -----
coerceTo: cTypeString sim: interpreter
| bits unitSize |
cTypeString last == $* ifTrue: "C pointer"
[unitSize := cTypeString caseOf: {
[#'char *'] -> [1].
[#'short *'] -> [2].
[#'int *'] -> [4].
[#'long long *'] -> [8].
[#'float *'] -> [^CFloatArray basicNew interpreter: interpreter address: self unitSize: 4; yourself].
[#'double *'] -> [^CFloatArray basicNew interpreter: interpreter address: self unitSize: 8; yourself].
[#'unsigned *'] -> [4].
[#'unsigned int *'] -> [4].
[#'unsigned char *'] -> [1].
[#'signed char *'] -> [1].
[#'unsigned short *'] -> [2].
[#'unsigned long long *'] -> [8].
[#'oop *'] -> [interpreter objectMemory bytesPerOop].
}
otherwise: [interpreter objectMemory wordSize].
^CArray basicNew
interpreter: interpreter address: self unitSize: unitSize;
yourself].
cTypeString first == $u ifTrue:
[bits := cTypeString caseOf: {
[#usqInt] -> [interpreter objectMemory wordSize * 8].
[#usqLong] -> [64].
[#unsigned] -> [32].
[#'unsigned char'] -> [8].
[#'unsigned int'] -> [8].
[#'unsigned long'] -> [48]. "LLP64 on Windows :-("
[#'unsigned long long'] -> [64].
[#'unsigned short'] -> [16].
}
otherwise: [self error: 'unknown unsigned integer type name'].
^self bitAnd: 1 << bits - 1].
bits := cTypeString caseOf: {
+ [#sqInt] -> [interpreter objectMemory wordSize * 8].
[#'sqIntptr_t'] -> [interpreter objectMemory wordSize * 8].
[#sqLong] -> [64].
[#char] -> [^self bitAnd: 255]. "char may be signed, may be unsigned; interpret as unsigned by default"
[#'signed char'] -> [8].
[#'short'] -> [16].
[#int] -> [32].
[#long] -> [48]. "LLP64 on Windows :-("
[#'long long'] -> [64].
[#'wint_t'] -> [24]. "unsigned short on Windows; int elsewhere"
+ [#double] -> [^self asFloat].
}
otherwise: [self error: 'unknown signed integer type name'].
^(self bitAnd: (1 bitShift: bits) - 1) - ((self bitAnd: (1 bitShift: bits - 1)) bitShift: 1)!
Item was added:
+ ----- Method: ObjectMemory>>followOopField:ofObject: (in category 'forward compatibility') -----
+ followOopField: fieldIndex ofObject: anObject
+ "Spur compatibility; in V3 this is a synonym for fetchPointer:ofObject:"
+ <inline: true>
+ ^self fetchPointer: fieldIndex ofObject: anObject!
Item was added:
+ ----- Method: SpurMemoryManager>>literal:ofMethod: (in category 'simulation only') -----
+ literal: offset ofMethod: methodPointer
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter literal: offset ofMethod: methodPointer!
Item was changed:
----- Method: SpurMemoryManager>>memcpy:_:_: (in category 'simulation') -----
memcpy: destAddress _: sourceAddress _: bytes
"For SpurGenerationScavenger>>copyToFutureSpace:bytes:. N.B. If ranges overlap, must use memmove."
<doNotGenerate>
| nToCopy offset |
(destAddress isInteger and: [sourceAddress isInteger]) ifFalse: "CogMethodProxies..."
[(sourceAddress isCollection "String, etc..."
or: [sourceAddress isCArray
or: [destAddress isCArray]]) ifTrue:
+ [^super memcpy: destAddress
+ _: ((bytes = 8 and: [sourceAddress isFloat])
+ ifTrue:
+ [self flag: #endianness.
+ (ByteArray new: bytes)
+ unsignedLong64At: 1 put: sourceAddress asIEEE64BitWord;
+ yourself]
+ ifFalse: [sourceAddress])
+ _: bytes].
- [^super memcpy: destAddress _: sourceAddress _: bytes].
^self memcpy: destAddress asInteger _: sourceAddress asInteger _: bytes].
self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]]).
self assert: (destAddress \\ 8) + (sourceAddress \\ 8) = 0. "for now..."
nToCopy := bytes.
offset := 0.
memory bytesPerElement = 8 ifTrue:
[0 to: nToCopy - 8 by: 8 do:
[:i| self long64At: destAddress + i put: (self long64At: sourceAddress + i)].
offset := nToCopy - (nToCopy \\ 8).
nToCopy := nToCopy \\ 8].
nToCopy >= 4 ifTrue:
[0 to: nToCopy - 4 by: 4 do:
[:i| self long32At: destAddress + i + offset put: (self long32At: sourceAddress + i + offset)].
offset := offset + nToCopy - (nToCopy \\ 4).
nToCopy := nToCopy \\ 4].
0 to: nToCopy - 1 do:
[:i| self byteAt: destAddress + i + offset put: (self byteAt: sourceAddress + i + offset)].
^destAddress!
Item was changed:
----- Method: SpurMemoryManager>>pinObject: (in category 'primitive support') -----
pinObject: objOop
"Attempt to pin objOop, which must not be immediate.
If the attempt succeeds answer objOop's (possibly moved) oop.
If the attempt fails, which can only occur if there is no memory, answer 0."
<inline: false>
| oldClone seg |
<var: #seg type: #'SpurSegmentInfo *'>
self assert: (self isNonImmediate: objOop).
+ self deny: (self isForwarded: objOop).
self flag: 'policy decision here. if already old, do we clone in a segment containing pinned objects or merely pin?'.
"We choose to clone to keep pinned objects together to reduce fragmentation,
if the object is not too large, assuming that pinning is rare and that fragmentation is a bad thing.
Too large is defined as over 1mb. The size of a 640x480x4 bitmap is 1228800."
(self isOldObject: objOop) ifTrue:
[(self numBytesOf: objOop) > (1024 * 1024) ifTrue:
[self setIsPinnedOf: objOop to: true.
^objOop].
seg := segmentManager segmentContainingObj: objOop.
seg containsPinned ifTrue:
[self setIsPinnedOf: objOop to: true.
^objOop].
segmentManager someSegmentContainsPinned ifFalse:
[self setIsPinnedOf: objOop to: true.
seg containsPinned: true.
^objOop]].
oldClone := self cloneInOldSpace: objOop forPinning: true.
oldClone ~= 0 ifTrue:
[becomeEffectsFlags := self becomeEffectFlagsFor: objOop.
self setIsPinnedOf: oldClone to: true.
self forward: objOop to: oldClone.
self followSpecialObjectsOop.
coInterpreter postBecomeAction: becomeEffectsFlags.
self postBecomeScanClassTable: becomeEffectsFlags.
becomeEffectsFlags := 0].
^oldClone!
Item was added:
+ ----- Method: SpurMemoryManager>>primitiveMethod (in category 'simulation only') -----
+ primitiveMethod
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter primitiveMethod!
Item was changed:
----- Method: SpurMemoryManager>>unalignedShortAt:put: (in category 'simulation') -----
unalignedShortAt: index put: aValue
"Support for primitiveFFIIntegerAt[Put]"
<doNotGenerate>
(index bitAnd: 1) = 0 ifTrue:
+ [^self shortAt: index put: (aValue bitAnd: 16rFFFF)].
- [^self shortAt: index put: aValue].
self shouldBeImplemented.
^aValue!
Item was changed:
----- Method: SpurSegmentManager>>findEmptySegNearestInSizeTo: (in category 'growing/shrinking memory') -----
findEmptySegNearestInSizeTo: size
| seg best delta |
<var: #seg type: #'SpurSegmentInfo *'>
<var: #best type: #'SpurSegmentInfo *'>
best := nil.
delta := size.
0 to: numSegments - 1 do:
[:i|
seg := self addressOf: (segments at: i).
(self isEmptySegment: seg) ifTrue:
[best
ifNil: [best := seg]
ifNotNil:
[(size >= (seg segSize * 0.75)
+ and: [(manager cCoerce: seg segSize - size to: #sqInt) abs < delta]) ifTrue:
+ [best := seg. delta := (manager cCoerce: seg segSize - size to: #sqInt) abs]]]].
- and: [(self cCoerce: (seg segSize - size) to: #sqInt ) abs < delta]) ifTrue:
- [best := seg. delta := (self cCoerce: (seg segSize - size) to: #sqInt ) abs]]]].
^best!
Item was changed:
----- Method: StackInterpreter>>asciiOfCharacter: (in category 'indexing primitive support') -----
asciiOfCharacter: characterObj "Returns an integer object"
<inline: false>
(objectMemory isCharacterObject: characterObj) ifTrue:
+ [^objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [objectMemory integerObjectOfCharacterObject: characterObj]
+ ifFalse: [objectMemory fetchPointer: CharacterValueIndex ofObject: characterObj]].
- [^CharacterTable
- ifNil: [objectMemory integerObjectOfCharacterObject: characterObj]
- ifNotNil: [objectMemory fetchPointer: CharacterValueIndex ofObject: characterObj]].
self primitiveFailFor: PrimErrBadArgument.
^ConstZero "in case some code needs an int"!
Item was changed:
----- Method: StackInterpreter>>dispatchFunctionPointer: (in category 'message sending') -----
dispatchFunctionPointer: aFunctionPointer
"In C aFunctionPointer is void (*aFunctionPointer)()"
<cmacro: '(aFunctionPointer) (aFunctionPointer)()'>
"In Smalltalk aFunctionPointer is a message selector symbol, except for
external primitives which are funkily encoded as integers >= 1000."
(aFunctionPointer isInteger
+ and: [aFunctionPointer >= 1000
+ or: [aFunctionPointer = primitiveCalloutPointer and: [aFunctionPointer > 0]]])
- and: [aFunctionPointer >= 1000])
ifTrue: [self callExternalPrimitive: aFunctionPointer]
ifFalse: [self perform: aFunctionPointer]!
Item was changed:
----- Method: StackInterpreter>>postGCUpdateDisplayBits (in category 'object memory support') -----
postGCUpdateDisplayBits
"Update the displayBits after a GC may have moved it.
Answer if the displayBits appear valid. The wrinkle here is that the displayBits could be a surface handle."
<inline: false>
| displayObj bitsOop bitsNow |
displayObj := objectMemory splObj: TheDisplay.
((objectMemory isPointers: displayObj)
and: [(objectMemory lengthOf: displayObj) >= 4]) ifFalse:
[^false].
+ bitsOop := objectMemory followOopField: 0 ofObject: displayObj.
- bitsOop := objectMemory fetchPointer: 0 ofObject: displayObj.
(bitsOop = objectMemory nilObject "it ain't yet set"
or: [objectMemory isIntegerObject: bitsOop]) ifTrue: "It's a surface; our work here is done..."
[^true].
self assert: ((objectMemory addressCouldBeObj: bitsOop)
and: [objectMemory isWordsOrBytes: bitsOop]).
(objectMemory hasSpurMemoryManagerAPI
and: [objectMemory isPinned: bitsOop]) ifFalse:
+ [(objectMemory hasSpurMemoryManagerAPI
+ and: [stackPage ~= 0]) ifTrue: "If stackPage is zero we're snapshotting and now is not the time to pin."
+ [objectMemory pinObject: bitsOop.
+ bitsOop := objectMemory followOopField: 0 ofObject: displayObj].
+ bitsNow := self cCode: [objectMemory firstIndexableField: bitsOop]
- [bitsNow := self cCode: [objectMemory firstIndexableField: bitsOop]
inSmalltalk: [(objectMemory firstIndexableField: bitsOop) asInteger].
+ displayBits ~= bitsNow ifTrue:
- displayBits ~= bitsNow ifTrue:
[displayBits := bitsNow.
+ self ioNoteDisplayChanged: displayBits width: displayWidth height: displayHeight depth: displayDepth]].
- self ioNoteDisplayChanged: displayBits width: displayWidth height: displayHeight depth: displayDepth].
- (objectMemory hasSpurMemoryManagerAPI
- and: [stackPage ~= 0]) ifTrue: "If stackPage is zero we're snapshotting and now is not the time to pin."
- [objectMemory pinObject: bitsOop]].
^true!
Item was changed:
----- Method: StackInterpreterSimulator>>primitivePerform (in category 'debugging traps') -----
primitivePerform
+ "Add a filter to perform to allow hacking of startup sequences in the simulator, eliding modules that can't yet be simulated."
+ | receiver selector |
+ receiver := self stackValue: argumentCount.
- | selector |
selector := self stackValue: argumentCount - 1.
+ self sendBreakpoint: selector receiver: receiver.
+ (self filterPerformOf: selector to: receiver) ifTrue:
- self sendBreakpoint: selector receiver: (self stackValue: argumentCount).
- (self filterPerformOf: selector to: (self stackValue: argumentCount)) ifTrue:
[^self pop: argumentCount].
^super primitivePerform!
Item was added:
+ ----- Method: TConstantNode>>isNilNode (in category 'testing') -----
+ isNilNode
+ ^value == nil!
Item was added:
+ ----- Method: TMethod>>pragmaAt: (in category 'accessing') -----
+ pragmaAt: aSelector
+ ^self compiledMethod pragmaAt: aSelector!
Item was added:
+ ----- Method: TParseNode>>isNilNode (in category 'testing') -----
+ isNilNode
+ ^false!
Item was added:
+ ----- Method: TVariableNode>>isNilNode (in category 'testing') -----
+ isNilNode
+ ^name = 'nil'!
Item was changed:
----- Method: VMClass>>sizeof: (in category 'translation support') -----
sizeof: objectSymbolOrClass
<doNotGenerate>
| index |
+ objectSymbolOrClass isNumber ifTrue:
+ [objectSymbolOrClass isInteger ifTrue:
+ [^self class objectMemoryClass wordSize].
+ objectSymbolOrClass isFloat ifTrue: "assume double"
+ [^8]].
- objectSymbolOrClass isInteger ifTrue:
- [^self class objectMemoryClass wordSize].
(#(usqInt sqInt) includes: objectSymbolOrClass) ifTrue: [^self class objectMemoryClass bytesPerOop].
objectSymbolOrClass isSymbol ifTrue:
[(objectSymbolOrClass last == $*
or: [#(#long #'unsigned long' #'sqIntptr_t' #'usqIntptr_t' #'size_t') includes: objectSymbolOrClass]) ifTrue:
[^self class objectMemoryClass wordSize].
index := #( #sqLong #usqLong #double
#int #'unsigned int' #float
#short #'unsigned short'
#char #'unsigned char' #'signed char')
indexOf: objectSymbolOrClass
ifAbsent:
[self error: 'unrecognized C type name'].
^#(8 8 8
4 4 4
2 2
1 1 1) at: index].
^(objectSymbolOrClass isBehavior
ifTrue: [objectSymbolOrClass]
ifFalse: [objectSymbolOrClass class])
alignedByteSizeOf: objectSymbolOrClass
forClient: self!
More information about the Vm-dev
mailing list