[Vm-dev] VM Maker: VMMaker.oscog-eem.307.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Jul 19 18:15:00 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.307.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.307
Author: eem
Time: 19 July 2013, 11:12:32.01 am
UUID: 737feb1e-5228-463a-8f3e-0f55f10fc3c9
Ancestors: VMMaker.oscog-eem.306
Fix simulation of ImageSegmentTest by using correct receivers, and
by fixing the cast to char * in FilePlugin>>primitiveFileRead. Change
FilePlugin>>primitiveFileWrite to match.
Rename kernel: and builtin: to isKernelSelector: and isBuiltinSelector:.
Add cCoerce:to: and cCoerceSimple:to: to kernel selectors.
Make simulator check for last object overwritten after calling
functions through dispatchFunctionPointer: and handleCallOrJumpSimulationTrap:.
Add checks for writing past freeStart to byteAt:put: and simulated
storePointer:ofObject:withValue: et al.
Delete a number of bogus reverseBytesFrom:to: implementations in
favour of ObjectMemory>>reverseBytesFrom:to:.
Move printMemoryFrom:to: to NewObjectMemory.
Fix overriding base in promptHex:
=============== Diff against VMMaker.oscog-eem.306 ===============
Item was changed:
----- Method: CArray>>coerceTo:sim: (in category 'converting') -----
coerceTo: cTypeString sim: interpreterSimulator
^cTypeString caseOf: {
['int'] -> [self ptrAddress].
['float *'] -> [self asCArrayAccessor asFloatAccessor].
['int *'] -> [self asCArrayAccessor asIntAccessor].
+ ['char *'] -> [self shallowCopy unitSize: 1; yourself].
['unsigned'] -> [self ptrAddress].
['sqInt'] -> [self ptrAddress].
['usqInt'] -> [self ptrAddress] }!
Item was removed:
- ----- Method: CCodeGenerator>>builtin: (in category 'utilities') -----
- builtin: sel
- "Answer true if the given selector is one of the builtin selectors."
-
- ^(self kernel: sel) or: [translationDict includesKey: sel]!
Item was added:
+ ----- Method: CCodeGenerator>>isBuiltinSelector: (in category 'utilities') -----
+ isBuiltinSelector: sel
+ "Answer true if the given selector is one of the builtin selectors."
+
+ ^(self isKernelSelector: sel) or: [translationDict includesKey: sel]!
Item was added:
+ ----- Method: CCodeGenerator>>isKernelSelector: (in category 'utilities') -----
+ isKernelSelector: sel
+ "Answer true if the given selector is one of the kernel selectors that are implemented as macros."
+
+ ^(#(error:
+ oopAt: oopAt:put: oopAtPointer: oopAtPointer:put:
+ byteAt: byteAt:put: byteAtPointer: byteAtPointer:put:
+ shortAt: shortAt:put: shortAtPointer: shortAtPointer:put:
+ intAt: intAt:put: intAtPointer: intAtPointer:put:
+ longAt: longAt:put: longAtPointer: longAtPointer:put:
+ fetchFloatAt:into: storeFloatAt:from:
+ fetchFloatAtPointer:into: storeFloatAtPointer:from:
+ fetchSingleFloatAt:into: storeSingleFloatAt:from:
+ fetchSingleFloatAtPointer:into: storeSingleFloatAtPointer:from:
+ pointerForOop: oopForPointer:
+ cCoerce:to: cCoerceSimple:to:)
+ includes: sel)!
Item was removed:
- ----- Method: CCodeGenerator>>kernel: (in category 'utilities') -----
- kernel: sel
- "Answer true if the given selector is one of the kernel selectors that are implemented as macros."
-
- ^(#(error:
- oopAt: oopAt:put: oopAtPointer: oopAtPointer:put:
- byteAt: byteAt:put: byteAtPointer: byteAtPointer:put:
- shortAt: shortAt:put: shortAtPointer: shortAtPointer:put:
- intAt: intAt:put: intAtPointer: intAtPointer:put:
- longAt: longAt:put: longAtPointer: longAtPointer:put:
- fetchFloatAt:into: storeFloatAt:from:
- fetchFloatAtPointer:into: storeFloatAtPointer:from:
- fetchSingleFloatAt:into: storeSingleFloatAt:from:
- fetchSingleFloatAtPointer:into: storeSingleFloatAtPointer:from:
- pointerForOop: oopForPointer:)
- includes: sel)!
Item was changed:
----- Method: CCodeGenerator>>messageReceiverIsInterpreterProxy: (in category 'utilities') -----
messageReceiverIsInterpreterProxy: sendNode
^self isGeneratingPluginCode
and: [sendNode receiver isVariable
and: ['interpreterProxy' = sendNode receiver name
+ and: [(self isKernelSelector: sendNode selector) not]]]!
- and: [(self kernel: sendNode selector) not]]]!
Item was changed:
----- Method: CCodeGenerator>>removeUnneededBuiltins (in category 'public') -----
removeUnneededBuiltins
| toRemove |
toRemove := Set new: 64.
methods keysDo:
[:sel|
+ (self isBuiltinSelector: sel) ifTrue:
- (self builtin: sel) ifTrue:
[(requiredSelectors includes: sel) ifFalse:
[toRemove add: sel]]].
toRemove do:
[:sel| self removeMethodForSelector: sel]!
Item was removed:
- ----- Method: CogVMSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- objectMemory memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
| evaluable function result savedFramePointer savedStackPointer savedArgumentCount rpc |
evaluable := simulatedTrampolines at: aProcessorSimulationTrap address.
function := evaluable
isBlock ifTrue: ['aBlock; probably some plugin primitive']
ifFalse: [evaluable selector].
function ~~ #ceBaseFrameReturn: ifTrue:
[coInterpreter assertValidExternalStackPointers].
(function beginsWith: 'ceShort') ifTrue:
[^self perform: function with: aProcessorSimulationTrap].
aProcessorSimulationTrap type = #call
ifTrue:
[processor
simulateCallOf: aProcessorSimulationTrap address
nextpc: aProcessorSimulationTrap nextpc
memory: coInterpreter memory.
self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}]
ifFalse:
[processor
simulateJumpCallOf: aProcessorSimulationTrap address
memory: coInterpreter memory.
self recordInstruction: {'(simulated jump to '. aProcessorSimulationTrap address. '/'. function. ')'}].
savedFramePointer := coInterpreter framePointer.
savedStackPointer := coInterpreter stackPointer.
savedArgumentCount := coInterpreter argumentCount.
result := ["self halt: evaluable selector."
evaluable valueWithArguments: (processor
postCallArgumentsNumArgs: evaluable numArgs
in: coInterpreter memory)]
on: ReenterMachineCode
do: [:ex| ex return: ex returnValue].
coInterpreter assertValidExternalStackPointers.
"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
not called something that has built a frame, such as closure value or evaluate method, or
switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
(function beginsWith: 'primitive') ifTrue:
+ [objectMemory checkForLastObjectOverwrite.
+ coInterpreter primFailCode = 0
- [coInterpreter primFailCode = 0
ifTrue: [(#( primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
primitiveExecuteMethodArgsArray primitiveExecuteMethod
primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs)
includes: function) ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer + (savedArgumentCount * BytesPerWord)
= coInterpreter stackPointer]]
ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer = coInterpreter stackPointer]].
result ~~ #continueNoReturn ifTrue:
[self recordInstruction: {'(simulated return to '. processor retpcIn: coInterpreter memory. ')'}.
rpc := processor retpcIn: coInterpreter memory.
self assert: (rpc >= codeBase and: [rpc < methodZone freeStart]).
processor
smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: BytesPerWord;
simulateReturnIn: coInterpreter memory].
self assert: (result isInteger "an oop result"
or: [result == coInterpreter
or: [result == objectMemory
or: [#(nil continue continueNoReturn) includes: result]]]).
processor cResultRegister: (result
ifNil: [0]
ifNotNil: [result isInteger
ifTrue: [result]
ifFalse: [16rF00BA222]])
"coInterpreter cr.
processor sp + 32 to: processor sp - 32 by: -4 do:
[:sp|
sp = processor sp
ifTrue: [coInterpreter print: 'sp->'; tab]
ifFalse: [coInterpreter printHex: sp].
coInterpreter tab; printHex: (coInterpreter longAt: sp); cr]"!
Item was changed:
----- Method: FilePlugin>>primitiveFileRead (in category 'file primitives') -----
primitiveFileRead
<export: true>
| retryCount count startIndex array file elementSize bytesRead |
<var: 'file' type: #'SQFile *'>
<var: 'count' type: #'size_t'>
<var: 'startIndex' type: #'size_t'>
<var: 'elementSize' type: #'size_t'>
retryCount := 0.
count := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
startIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
[array := interpreterProxy stackValue: 2.
file := self fileValueOf: (interpreterProxy stackValue: 3).
(interpreterProxy failed
"buffer can be any indexable words or bytes object except CompiledMethod"
or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
(startIndex >= 1
and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
"Note: adjust startIndex for zero-origin indexing"
bytesRead := self
sqFile: file
Read: count * elementSize
+ Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
- Into: (self cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
At: (startIndex - 1) * elementSize.
interpreterProxy primitiveFailureCode = PrimErrObjectMayMove
and: [(retryCount := retryCount + 1) <= 2] "Two objects, the file and the array can move"] whileTrue:
[interpreterProxy
tenuringIncrementalGC;
primitiveFailFor: PrimNoErr].
interpreterProxy failed ifFalse:
[interpreterProxy
pop: 5 "pop rcvr, file, array, startIndex, count"
thenPush:(interpreterProxy integerObjectOf: bytesRead // elementSize) "push # of elements read"]!
Item was changed:
----- Method: FilePlugin>>primitiveFileWrite (in category 'file primitives') -----
primitiveFileWrite
+ | count startIndex array file elementSize bytesWritten |
- | count startIndex array file byteSize arrayIndex bytesWritten |
<var: 'file' type: 'SQFile *'>
<var: 'arrayIndex' type: 'char *'>
<var: 'count' type: 'size_t'>
<var: 'startIndex' type: 'size_t'>
+ <var: 'elementSize' type: 'size_t'>
- <var: 'byteSize' type: 'size_t'>
<export: true>
count := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
startIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
array := interpreterProxy stackValue: 2.
file := self fileValueOf: (interpreterProxy stackValue: 3).
+
+ (interpreterProxy failed
+ "buffer can be any indexable words or bytes object except CompiledMethod"
+ or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+
+ elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
+ (startIndex >= 1
+ and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+
+ "Note: adjust startIndex for zero-origin indexing"
+ bytesWritten := self
- "buffer can be any indexable words or bytes object except CompiledMethod "
- (interpreterProxy isWordsOrBytes: array)
- ifFalse: [^ interpreterProxy primitiveFail].
- (interpreterProxy isWords: array)
- ifTrue: [byteSize := 4]
- ifFalse: [byteSize := 1].
- (startIndex >= 1 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)])
- ifFalse: [^ interpreterProxy primitiveFail].
- interpreterProxy failed
- ifFalse: [arrayIndex := interpreterProxy firstIndexableField: array.
- "Note: adjust startIndex for zero-origin indexing"
- bytesWritten := self
sqFile: file
+ Write: count * elementSize
+ From: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
+ At: startIndex - 1 * elementSize.
+ interpreterProxy failed ifFalse:
+ [interpreterProxy pop: 5 thenPush: (interpreterProxy integerObjectOf: bytesWritten // elementSize)]!
- Write: count * byteSize
- From: arrayIndex
- At: startIndex - 1 * byteSize].
- interpreterProxy failed
- ifFalse: [interpreterProxy pop: 5 thenPush:( interpreterProxy integerObjectOf: bytesWritten // byteSize)]!
Item was removed:
- ----- Method: InterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: NewCoObjectMemory>>copyObj:toSegment:addr:stopAt:saveOopAt:headerAt: (in category 'image segment in/out') -----
copyObj: oop toSegment: segmentWordArray addr: lastSeg stopAt: stopAddr saveOopAt: oopPtr headerAt: hdrPtr
"Copy this object into the segment beginning at lastSeg.
Install a forwarding pointer, and save oop and header.
Fail if out of space. Return the next segmentAddr if successful."
"Copy the object..."
| extraSize bodySize hdrAddr |
<inline: false>
self flag: #Dan. "None of the imageSegment stuff has been updated for 64 bits"
extraSize := self extraHeaderBytes: oop.
bodySize := self sizeBitsOf: oop.
(self oop: (lastSeg + extraSize + bodySize) isGreaterThanOrEqualTo: stopAddr) ifTrue:
[^0]. "failure"
self transfer: extraSize + bodySize // BytesPerWord "wordCount"
from: oop - extraSize
to: lastSeg+BytesPerWord.
"Clear root and mark bits of all headers copied into the segment"
hdrAddr := lastSeg+BytesPerWord + extraSize.
self longAt: hdrAddr put: ((self longAt: hdrAddr) bitAnd: AllButRootBit - MarkBit).
"Make sure Cogged methods have their true header field written to the segment."
((self isCompiledMethod: oop)
+ and: [coInterpreter methodHasCogMethod: oop]) ifTrue:
+ [self longAt: hdrAddr+BaseHeaderSize put: (coInterpreter headerOf: oop)].
- and: [self methodHasCogMethod: oop]) ifTrue:
- [self longAt: hdrAddr+BaseHeaderSize put: (self headerOf: oop)].
self forward: oop to: (lastSeg+BytesPerWord + extraSize - segmentWordArray)
savingOopAt: oopPtr
andHeaderAt: hdrPtr.
"Return new end of segment"
^lastSeg + extraSize + bodySize!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>fetchPointer:ofObject: (in category 'interpreter access') -----
fetchPointer: fieldIndex ofObject: oop
"index by word size, and return a pointer as long as the word size"
self assert: oop >= self startOfMemory.
+ self assert: oop + BaseHeaderSize + (fieldIndex << ShiftForWord) < freeStart.
^super fetchPointer: fieldIndex ofObject: oop!
Item was removed:
- ----- Method: NewCoObjectMemorySimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>storePointer:ofObject:withValue: (in category 'interpreter access') -----
+ storePointer: fieldIndex ofObject: oop withValue: valuePointer
- storePointer: index ofObject: oop withValue: valuePointer
"Override to ensure acess is within the heap, and within the object"
| fmt hdr |
self assert: oop >= self startOfMemory.
hdr := self baseHeader: oop.
fmt := self formatOfHeader: hdr.
self assert: ((fmt <= 4 or: [fmt >= 12])
+ and: [fieldIndex >= 0 and: [fieldIndex < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
+ self assert: oop + BaseHeaderSize + (fieldIndex << ShiftForWord) < freeStart.
+ ^super storePointer: fieldIndex ofObject: oop withValue: valuePointer!
- and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
- ^super storePointer: index ofObject: oop withValue: valuePointer!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>storePointerUnchecked:ofObject:withValue: (in category 'interpreter access') -----
+ storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
- storePointerUnchecked: index ofObject: oop withValue: valuePointer
"Override to ensure acess is within the heap, and within the object"
| fmt hdr |
self assert: oop >= self startOfMemory.
hdr := self baseHeader: oop.
fmt := self formatOfHeader: hdr.
self assert: ((fmt <= 4 or: [fmt >= 12])
+ and: [fieldIndex >= 0 and: [fieldIndex < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
+ self assert: oop + BaseHeaderSize + (fieldIndex << ShiftForWord) < freeStart.
+ ^super storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer!
- and: [index >= 0 and: [index < (self lengthOf: oop baseHeader: hdr format: fmt)]]).
- ^super storePointerUnchecked: index ofObject: oop withValue: valuePointer!
Item was changed:
----- Method: NewCoObjectMemorySimulatorLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
long := (lowBits caseOf: {
[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ]
}).
+ self assert: longAddress < freeStart.
-
self longAt: longAddress put: long.
^byte!
Item was changed:
----- Method: NewCoObjectMemorySimulatorMSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| longWord shift lowBits bpwMinus1 longAddress |
bpwMinus1 := BytesPerWord-1.
lowBits := byteAddress bitAnd: bpwMinus1.
longAddress := byteAddress - lowBits.
longWord := self longAt: longAddress.
shift := (bpwMinus1 - lowBits) * 8.
longWord := longWord
- (longWord bitAnd: (16rFF bitShift: shift))
+ (byte bitShift: shift).
+ self assert: longAddress < freeStart.
self longAt: longAddress put: longWord.
^byte!
Item was added:
+ ----- Method: NewObjectMemory>>checkForLastObjectOverwrite (in category 'allocation') -----
+ checkForLastObjectOverwrite
+ <doNotGenerate>
+ self assert: (freeStart >= scavengeThreshold
+ or: [(AllocationCheckFiller = 0
+ or: [(self longAt: freeStart) = (AllocationCheckFiller = 16rADD4E55
+ ifTrue: [freeStart]
+ ifFalse: [AllocationCheckFiller])])])!
Item was added:
+ ----- Method: NewObjectMemory>>imageSegmentVersion (in category 'image segment in/out') -----
+ imageSegmentVersion
+ | wholeWord |
+ "a more complex version that tells both the word reversal and the endianness of the machine it came from. Low half of word is 6502. Top byte is top byte of #doesNotUnderstand: on this machine. ($d on the Mac or $s on the PC)"
+
+ wholeWord := self longAt: (self splObj: SelectorDoesNotUnderstand) + BaseHeaderSize.
+ "first data word, 'does' "
+ ^coInterpreter imageFormatVersion bitOr: (wholeWord bitAnd: 16rFF000000)!
Item was added:
+ ----- Method: NewObjectMemory>>printMemoryFrom:to: (in category 'printing') -----
+ printMemoryFrom: start to: end
+ <doNotGenerate>
+ | address |
+ address := start bitAnd: (BytesPerWord - 1) bitInvert.
+ [address < end] whileTrue:
+ [coInterpreter printHex: address; printChar: $:; space; printHex: (self longAt: address); cr.
+ address := address + BytesPerWord]!
Item was changed:
----- Method: NewObjectMemory>>safePrintStringOf: (in category 'debug printing') -----
safePrintStringOf: oop
"Version of printStringOf: that copes with forwarding during garbage collection."
| fmt header cnt i |
<inline: false>
(self isIntegerObject: oop) ifTrue:
[^nil].
(oop between: self startOfMemory and: freeStart) ifFalse:
[^nil].
(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
[^nil].
header := self headerWhileForwardingOf: oop.
fmt := self formatOfHeader: header.
fmt < 8 ifTrue: [ ^nil ].
cnt := 100 min: (self lengthOf: oop baseHeader: header format: fmt).
i := 0.
[i < cnt] whileTrue:
[self printChar: (self fetchByte: i ofObject: oop).
i := i + 1].
+ coInterpreter flush.
- self flush.
^oop!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>printMemoryFrom:to: (in category 'printing') -----
- printMemoryFrom: start to: end
- | address |
- address := start bitAnd: (BytesPerWord - 1) bitInvert.
- [address < end] whileTrue:
- [self printHex: address; printChar: $:; space; printHex: (self longAt: address); cr.
- address := address + BytesPerWord]!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: NewObjectMemorySimulatorLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
long := (lowBits caseOf: {
[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ]
}).
+ self assert: longAddress < freeStart.
-
self longAt: longAddress put: long.
^byte!
Item was changed:
----- Method: NewObjectMemorySimulatorMSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| longWord shift lowBits bpwMinus1 longAddress |
bpwMinus1 := BytesPerWord-1.
lowBits := byteAddress bitAnd: bpwMinus1.
longAddress := byteAddress - lowBits.
longWord := self longAt: longAddress.
shift := (bpwMinus1 - lowBits) * 8.
longWord := longWord
- (longWord bitAnd: (16rFF bitShift: shift))
+ (byte bitShift: shift).
+ self assert: longAddress < freeStart.
self longAt: longAddress put: longWord.
^byte!
Item was removed:
- ----- Method: NewspeakInterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: ObjectMemory>>reverseBytesFrom:to: (in category 'image save/restore') -----
reverseBytesFrom: startAddr to: stopAddr
"Byte-swap the given range of memory (not inclusive of stopAddr!!)."
| addr |
- self flag: #Dan.
addr := startAddr.
[self oop: addr isLessThan: stopAddr] whileTrue:
[self longAt: addr put: (self byteSwapped: (self longAt: addr)).
addr := addr + BytesPerWord].!
Item was changed:
----- Method: StackInterpreter>>dispatchFunctionPointer: (in category 'message sending') -----
dispatchFunctionPointer: aFunctionPointer
"In C aFunctionPointer is void (*aFunctionPointer)()"
<cmacro: '(aFunctionPointer) (aFunctionPointer)()'>
+ | result |
(aFunctionPointer isInteger
and: [aFunctionPointer >= 1000]) ifTrue:
+ [result := self callExternalPrimitive: aFunctionPointer.
+ objectMemory checkForLastObjectOverwrite.
+ ^result].
- [^self callExternalPrimitive: aFunctionPointer].
"In Smalltalk aFunctionPointer is a message selector symbol"
+ result := self perform: aFunctionPointer.
+ objectMemory checkForLastObjectOverwrite.
+ ^result!
- ^self perform: aFunctionPointer!
Item was removed:
- ----- Method: StackInterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
- reverseBytesFrom: begin to: end
- "Byte-swap the given range of memory (not inclusive!!)."
- | wordAddr |
- wordAddr := begin.
- objectMemory memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
prepareMethodIn: aCodeGen
"Record sends of builtin operators, map sends of the special selector dispatchOn:in:
with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:].
These must be top-level statements; they cannot appear in expressions.
As a hack also update the types of variables introduced to implement cascades correctly.
This has to be done at teh same time as this is done, so why not piggy back here?"
| replacements |.
cascadeVariableNumber ifNotNil:
[declarations keysAndValuesDo:
[:varName :decl|
decl isBlock ifTrue:
[self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
locals add: varName.
self declarationAt: varName
put: (decl value: self value: aCodeGen), ' ', varName]]].
replacements := IdentityDictionary new.
aCodeGen
pushScope: declarations
while:
[parseTree nodesDo:
[:node|
node isSend ifTrue:
+ [(aCodeGen isBuiltinSelector: node selector)
- [(aCodeGen builtin: node selector)
ifTrue:
[node isBuiltinOperator: true.
"If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
(node selector = #to:by:do:
and: [node args size = 4]) ifTrue:
[| limitExpr |
limitExpr := node args first.
(limitExpr anySatisfy:
[:subNode|
subNode isSend
+ and: [(aCodeGen isBuiltinSelector: subNode selector) not
- and: [(aCodeGen builtin: subNode selector) not
and: [(subNode isStructSend: aCodeGen) not]]])
ifTrue: [locals add: node args last name]
ifFalse:
[node arguments: node args allButLast]]]
ifFalse:
[(CaseStatements includes: node selector) ifTrue:
[replacements at: node put: (self buildCaseStmt: node)].
(#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
[replacements at: node put: (self buildSwitchStmt: node)]]].
((node isAssignment or: [node isReturn])
and: [node expression isSwitch]) ifTrue:
[replacements at: node put: (self transformSwitchExpression: node)]]].
replacements isEmpty ifFalse:
[parseTree := parseTree replaceNodesIn: replacements]!
Item was changed:
----- Method: TSendNode>>bindVariableUsesIn:andConstantFoldIf:in: (in category 'transformations') -----
bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen
"Answer either the receiver, if it contains no references to the given variables, or a new node with the given variables rebound.
Attempt to constant-fold and answer a constant node commented with the original expression.
Commenting with the original expression is important because it allows us to detect shared cases.
e.g. currentBytecode bitAnd: 15 is the same in case 1 and case 17, but '1 /* 1 bitAnd: 15 */' differs
from '1 /* 17 bitAnd: 15 */', whereas '1 /* currentBytecode bitAnd: 15 */' doesn't change."
| newReceiver newArguments |
newReceiver := receiver bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen.
newArguments := arguments collect: [:a| a bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen].
(newReceiver = receiver
and: [newArguments = arguments]) ifTrue:
[^self].
(constantFold
and: [newReceiver isConstant and: [newReceiver value isInteger]
and: [(newArguments allSatisfy: [:ea| ea isConstant and: [ea value isInteger]])
+ and: [codeGen isBuiltinSelector: selector]]]) ifTrue:
- and: [codeGen builtin: selector]]]) ifTrue:
[| value |
value := [newReceiver value perform: selector withArguments: (newArguments collect: [:ea| ea value])]
on: Error
do: [:ea| nil].
(value isInteger
or: [value == true
or: [value == false]]) ifTrue:
[^TConstantNode new
setValue: value;
"We assume Message prints its keywords and arguments interleaved.
e.g. that (Message selector: #between:and: arguments: #(0 1)) printString = 'between: 0 and: 1'"
comment: (receiver isLeaf
ifTrue: [receiver printString]
ifFalse: ['(', receiver printString, ')']),
' ',
(Message selector: selector arguments: (arguments collect: [:ea| ea value])) printString;
yourself]].
^self shallowCopy
receiver: newReceiver;
arguments: newArguments;
yourself
!
Item was changed:
----- Method: VMClass>>promptHex: (in category 'simulation support') -----
promptHex: string
<doNotGenerate>
| s |
s := UIManager default request: string, ' (hex)'.
^s notEmpty ifTrue:
+ [(s includes: $r)
+ ifTrue:
+ [Number readFrom: s readStream]
+ ifFalse:
+ [(#('0x' '-0x') detect: [:prefix| s beginsWith: prefix] ifNone: []) ifNotNil:
+ [:prefix|
+ s := s allButFirst: prefix size.
+ prefix first = $- ifTrue: [s := '-', s]].
+ Integer readFrom: s readStream base: 16]]!
- [(#('16r' '-16r' '0x' '-0x') detect: [:prefix| s beginsWith: prefix] ifNone: []) ifNotNil:
- [:prefix|
- s := s allButFirst: prefix size.
- prefix first = $- ifTrue: [s := '-', s]].
- Integer readFrom: s readStream base: 16]!
Item was changed:
----- Method: VMPluginCodeGenerator>>pluginFunctionsToClone (in category 'public') -----
pluginFunctionsToClone
"Answer those of the used plugin functions to clone as a sorted collection.
Exclude those that are static to sqVirtualMachine.c and hence always need
to be called through interpreterProxy."
+ ^((pluginFunctionsUsed
+ reject: [:selector| self noteUsedPluginFunction: selector])
+ select: [:selector| InterpreterProxy includesSelector: selector])
+ asSortedCollection!
- ^(pluginFunctionsUsed reject:
- [:selector| self noteUsedPluginFunction: selector])
- asSortedCollection!
More information about the Vm-dev
mailing list