[Vm-dev] VM Maker: VMMaker.oscog-eem.1492.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Oct 18 00:34:04 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1492.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1492
Author: eem
Time: 17 October 2015, 5:32:12.348 pm
UUID: a0778a36-b0e9-4e06-af1a-0e50572c9db1
Ancestors: VMMaker.oscog-eem.1491
x64 Cogit:
Get the Cogit to a state where the 64-bit Spur image starts simulating. It's a new world ;-)
Reimplement CMethodCacheAccessor, introducing CArrayOfLongsAccessor for the primitive trace log.
Alter CogStackPage and surrogates so that CogStackPageSurrogate64 is properly laid out.
Revise the signedIntToFrom/Foo methods, and add some tests to check their behaviour.
Provide two move multi-tab browser opening conveniences.
=============== Diff against VMMaker.oscog-eem.1491 ===============
Item was added:
+ CObjectAccessor subclass: #CArrayOfLongsAccessor
+ instanceVariableNames: 'objectMemory address elementByteSize'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-JITSimulation'!
+
+ !CArrayOfLongsAccessor commentStamp: 'eem 10/8/2015 12:49' prior: 0!
+ A CArrayOfLongsAccessor is a class that wraps an Array stored in the heap. It maps at:[put:] into a suitably aligned and offset longAt:[put:], for accessing Arrays stored in the heap, such as the primTraceLog.
+
+ Instance Variables
+ address: <Integer>
+ entryByteSize: <Integer>
+ objectMemory: <NewCoObjectMemorySimulator|Spur64BitMMLECoSimulator|Spur64BitMMLECoSimulator|Spur64BitMMBECoSimulator|Spur64BitMMBECoSimulator>
+
+ address
+ - the base address in the heap of the start of the array
+
+ entryByteSize
+ - the size of an element, in bytes
+
+ objectMemory
+ - the memory manager whose heap is being accessed
+ !
Item was added:
+ ----- Method: CArrayOfLongsAccessor>>address (in category 'accessing') -----
+ address
+ ^address!
Item was added:
+ ----- Method: CArrayOfLongsAccessor>>at: (in category 'accessing') -----
+ at: index
+ "Map at: into a suitably aligned and offset longAt:, for accessing Arrays stored in the heap, such as the primTraceLog."
+ ^objectMemory longAt: index * elementByteSize + address!
Item was added:
+ ----- Method: CArrayOfLongsAccessor>>at:put: (in category 'accessing') -----
+ at: index put: aValue
+ "Map at:put: into a suitably aligned and offset longAt:put:, for accessing Arrays stored in the heap, such as the primTraceLog."
+ ^objectMemory longAt: index * elementByteSize + address put: aValue!
Item was added:
+ ----- Method: CArrayOfLongsAccessor>>objectMemory:at: (in category 'initialize-release') -----
+ objectMemory: anObjectMemory at: anAddress
+ objectMemory := anObjectMemory.
+ object := anObjectMemory memory.
+ offset := anAddress / anObjectMemory wordSize.
+ elementByteSize := anObjectMemory wordSize.
+ address := anAddress!
Item was changed:
+ CArrayOfLongsAccessor subclass: #CMethodCacheAccessor
+ instanceVariableNames: 'methodCacheArray entrySize functionPointerIndex'
- CObjectAccessor subclass: #CMethodCacheAccessor
- instanceVariableNames: 'methodCacheArray functionPointerIndex entrySize'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-JITSimulation'!
!CMethodCacheAccessor commentStamp: '<historical>' prior: 0!
I am used to simulate accesses to the methodCache so it can live partly in memory, partly in a Smalltalk Array. This is necessary because in simulation function pointers are Smalltalk symbols (under simulation primitive dispatch is done via perform:).
!
Item was changed:
----- Method: CMethodCacheAccessor>>at: (in category 'accessing') -----
at: index
"The special handling of functionPointerIndex is necessary because in simulation function
pointers are Smalltalk symbols (under simulation primitive dispatch is done via perform:)."
index - 1 \\ entrySize = functionPointerIndex ifTrue:
[^methodCacheArray at: index].
+ ^objectMemory longAt: index * elementByteSize + address!
- ^object at: index + offset!
Item was changed:
----- Method: CMethodCacheAccessor>>at:put: (in category 'accessing') -----
at: index put: value
"The special handling of functionPointerIndex is necessary because in simulation function
pointers are Smalltalk symbols (under simulation primitive dispatch is done via perform:)."
+ (index = 16r44F and: [value = 16r1D]) ifTrue:
+ [self halt].
index - 1 \\ entrySize = functionPointerIndex ifTrue:
+ [objectMemory longAt: index * elementByteSize + address put: (0 = value ifTrue: [value] ifFalse: [value identityHash]).
+ ^methodCacheArray at: index put: value].
+ ^objectMemory longAt: index * elementByteSize + address put: value!
- [^methodCacheArray at: index put: value].
- ^object at: index + offset put: value!
Item was removed:
- ----- Method: CMethodCacheAccessor>>memory:offset:array:functionPointerIndex:entrySize: (in category 'initialize-release') -----
- memory: anObject offset: baseIndex array: cacheArray functionPointerIndex: fpIndex entrySize: esz
- object := anObject.
- offset := baseIndex.
- methodCacheArray := cacheArray.
- functionPointerIndex := fpIndex - 1.
- entrySize := esz!
Item was added:
+ ----- Method: CMethodCacheAccessor>>objectMemory:at:array:functionPointerIndex:entrySize: (in category 'initialize-release') -----
+ objectMemory: anObjectMemory at: anAddress array: cacheArray functionPointerIndex: fpIndex entrySize: wordsPerCacheEntry
+ self objectMemory: anObjectMemory
+ at: anAddress - anObjectMemory wordSize. "implicit -1 for indices in at:[put:]; the MethodCache is one-relative"
+ methodCacheArray := cacheArray.
+ functionPointerIndex := fpIndex - 1.
+ entrySize := wordsPerCacheEntry!
Item was added:
+ ----- Method: CObjectAccessor class>>defaultIntegerBaseInDebugger (in category 'debugger') -----
+ defaultIntegerBaseInDebugger
+ ^VMClass defaultIntegerBaseInDebugger!
Item was changed:
----- Method: CoInterpreter>>methodCacheAddress (in category 'cog jit support') -----
methodCacheAddress
<api>
<returnTypeC: #'void *'>
+ ^self cCode: [methodCache] inSmalltalk: [methodCache address]!
- ^self cCode: [methodCache] inSmalltalk: [methodCache offset - 1 * objectMemory wordSize]!
Item was changed:
----- Method: CoInterpreterStackPages>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32Or64BitValue
- longAt: byteAddress put: a32BitValue
<doNotGenerate>
self assert: (byteAddress >= minStackAddress and: [byteAddress < maxStackAddress]).
+ ^objectMemory longAt: byteAddress put: a32Or64BitValue!
- ^objectMemory longAt: byteAddress put: a32BitValue!
Item was changed:
----- Method: CoInterpreterStackPagesLSB>>byteAt: (in category 'memory access') -----
byteAt: byteAddress
| lowBits long |
+ lowBits := byteAddress bitAnd: objectMemory wordSize - 1.
- lowBits := byteAddress bitAnd: 3.
long := self longAt: byteAddress - lowBits.
+ lowBits > 0 ifTrue:
+ [long := long bitShift: lowBits * -8].
+ ^long bitAnd: 16rFF!
- ^(lowBits caseOf: {
- [0] -> [ long ].
- [1] -> [ long bitShift: -8 ].
- [2] -> [ long bitShift: -16 ].
- [3] -> [ long bitShift: -24 ]
- }) bitAnd: 16rFF!
Item was changed:
----- Method: CoInterpreterStackPagesLSB>>byteAt:put: (in category 'memory access') -----
byteAt: byteAddress put: byte
| lowBits long longAddress |
+ self assert: (byte between: 0 and: 16rFF).
+ lowBits := byteAddress bitAnd: objectMemory wordSize - 1.
- lowBits := byteAddress bitAnd: 3.
longAddress := byteAddress - lowBits.
long := self longAt: longAddress.
+ long := (long bitOr: (16rFF bitShift: lowBits * 8)) bitXor: (byte bitXor: 16rFF).
- 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 longAt: longAddress put: long.
^byte!
Item was changed:
VMStructType subclass: #CogStackPage
+ instanceVariableNames: 'stackLimit headSP headFP baseFP baseAddress realStackLimit lastAddress trace padToWord nextPage prevPage'
- instanceVariableNames: 'stackLimit headSP headFP baseFP baseAddress realStackLimit lastAddress trace nextPage prevPage'
classVariableNames: ''
poolDictionaries: 'VMBasicConstants VMBytecodeConstants'
category: 'VMMaker-Interpreter'!
!CogStackPage commentStamp: 'eem 8/14/2015 12:06' prior: 0!
I am a class that helps organize the StackInterpreter's collection of stack pages. I represent the control block for a single stack page in the collection of stack pages represented by an InterpreterStackPages or CoInterpreterStackPages instance.!
Item was added:
+ ----- Method: CogStackPage class>>getter:bitPosition:bitWidth:type: (in category 'code generation') -----
+ getter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
+ ^String streamContents:
+ [:s| | startByte endByte accessor |
+ startByte := bitPosition // 8.
+ endByte := bitPosition + bitWidth - 1 // 8.
+ self assert: bitPosition \\ 8 = 0.
+ self assert: startByte \\ (bitWidth // 8) = 0.
+ accessor := #('byte' 'short' 'long' 'long')
+ at: endByte - startByte + 1
+ ifAbsent: ['long64'].
+ s nextPutAll: getter; crtab: 1; nextPut: $^.
+ (typeOrNil notNil and: [typeOrNil last = $*]) ifTrue:
+ [accessor := 'unsigned', (accessor copy
+ at: 1 put: accessor first asUppercase;
+ yourself)].
+ (typeOrNil notNil and: ['*StackPage*' match: typeOrNil]) ifTrue:
+ [s nextPutAll: 'stackPages surrogateAtAddress: ('].
+ s nextPutAll: 'memory ';
+ nextPutAll: accessor;
+ nextPutAll: 'At: address + '; print: startByte + 1.
+ (typeOrNil notNil and: ['*StackPage*' match: typeOrNil]) ifTrue:
+ [s nextPut: $)]]
+
+ "| bitPosition |
+ bitPosition := 0.
+ (self fieldAccessorsForBytesPerWord: 4) collect:
+ [:spec|
+ bitPosition := bitPosition + spec second.
+ self getter: spec first
+ bitPosition: bitPosition - spec second
+ bitWidth: spec second
+ type: (spec at: 3 ifAbsent: [])]"!
Item was changed:
----- Method: CogStackPage class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
instVarNamesAndTypesForTranslationDo: aBinaryBlock
"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a StackPage struct."
self allInstVarNames do:
[:ivn|
+ (ivn = 'padToWord' and: [BytesPerWord = 4]) ifFalse:
- ivn ~= 'stackPagesMemory' ifTrue:
[aBinaryBlock
value: ivn
+ value: ((ivn = 'trace' or: [ivn = 'padToWord'])
- value: (ivn = 'trace'
ifTrue: [#int]
ifFalse:
[(ivn endsWith: 'Page')
ifTrue: ['struct _StackPage *']
ifFalse: [#'char *']])]]!
Item was added:
+ ----- Method: CogStackPage class>>setter:bitPosition:bitWidth:type: (in category 'code generation') -----
+ setter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
+ ^String streamContents:
+ [:s| | startByte endByte accessor |
+ startByte := bitPosition // 8.
+ endByte := bitPosition + bitWidth - 1 // 8.
+ self assert: bitPosition \\ 8 = 0.
+ self assert: startByte \\ (bitWidth // 8) = 0.
+ accessor := #('byte' 'short' 'long' 'long')
+ at: endByte - startByte + 1
+ ifAbsent: ['long64'].
+ s nextPutAll: getter; nextPutAll: ': aValue'; crtab: 1;
+ nextPutAll: 'self assert: (address + '; print: startByte;
+ nextPutAll: ' >= zoneBase and: [address + '; print: endByte;
+ nextPutAll: ' < zoneLimit]).'; crtab: 1.
+ (typeOrNil notNil and: [typeOrNil last = $*]) ifTrue:
+ [accessor := 'unsigned', (accessor copy
+ at: 1 put: accessor first asUppercase;
+ yourself)].
+ (typeOrNil notNil and: ['*StackPage*' match: typeOrNil]) ifFalse:
+ [s nextPut: $^].
+ s nextPutAll: 'memory ';
+ nextPutAll: accessor; nextPutAll: 'At: address + '; print: startByte + 1;
+ nextPutAll: ' put: aValue'.
+ (typeOrNil notNil and: ['*StackPage*' match: typeOrNil]) ifTrue:
+ [s nextPutAll: ' asInteger.'; crtab: 1; nextPutAll: '^aValue']]
+
+ "| bitPosition |
+ bitPosition := 0.
+ (self fieldAccessorsForBytesPerWord: 4) collect:
+ [:spec|
+ bitPosition := bitPosition + spec second.
+ self setter: spec first
+ bitPosition: bitPosition - spec second
+ bitWidth: spec second
+ type: (spec at: 3 ifAbsent: [])]"!
Item was changed:
+ ----- Method: CogStackPageSurrogate32 class>>alignedByteSize (in category 'accessing') -----
- ----- Method: CogStackPageSurrogate32 class>>alignedByteSize (in category 'instance creation') -----
alignedByteSize
^40!
Item was changed:
----- Method: CogStackPageSurrogate32>>nextPage: (in category 'accessing') -----
nextPage: aValue
self assert: (address + 32 >= zoneBase and: [address + 35 < zoneLimit]).
+ memory unsignedLongAt: address + 33 put: aValue asInteger.
+ ^aValue!
- ^memory
- unsignedLongAt: address + 33
- put: aValue asInteger!
Item was added:
+ ----- Method: CogStackPageSurrogate32>>padToWord (in category 'accessing') -----
+ padToWord
+ ^memory longAt: address + 33!
Item was added:
+ ----- Method: CogStackPageSurrogate32>>padToWord: (in category 'accessing') -----
+ padToWord: aValue
+ self assert: (address + 32 >= zoneBase and: [address + 35 < zoneLimit]).
+ ^memory longAt: address + 33 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate32>>prevPage: (in category 'accessing') -----
prevPage: aValue
self assert: (address + 36 >= zoneBase and: [address + 39 < zoneLimit]).
+ memory unsignedLongAt: address + 37 put: aValue asInteger.
+ ^aValue!
- ^memory
- unsignedLongAt: address + 37
- put: aValue asInteger!
Item was changed:
----- Method: CogStackPageSurrogate32>>stackLimit: (in category 'accessing') -----
stackLimit: aValue
+ self assert: (address + 0 >= zoneBase and: [address + 3 < zoneLimit]).
+ ^memory unsignedLongAt: address + 1 put: aValue!
- self assert: (address >= zoneBase and: [address + 3 < zoneLimit]).
- ^memory unsignedLongAt: address + 1 put: aValue signedIntToLong!
Item was changed:
----- Method: CogStackPageSurrogate64>>baseAddress (in category 'accessing') -----
baseAddress
+ ^memory unsignedLong64At: address + 33!
- ^memory long64At: address + 33!
Item was changed:
----- Method: CogStackPageSurrogate64>>baseAddress: (in category 'accessing') -----
baseAddress: aValue
self assert: (address + 32 >= zoneBase and: [address + 39 < zoneLimit]).
+ ^memory unsignedLong64At: address + 33 put: aValue!
- ^memory long64At: address + 33 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate64>>baseFP (in category 'accessing') -----
baseFP
+ ^memory unsignedLong64At: address + 25!
- ^memory long64At: address + 25!
Item was changed:
----- Method: CogStackPageSurrogate64>>baseFP: (in category 'accessing') -----
baseFP: aValue
self assert: (address + 24 >= zoneBase and: [address + 31 < zoneLimit]).
+ ^memory unsignedLong64At: address + 25 put: aValue!
- ^memory long64At: address + 25 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate64>>headFP (in category 'accessing') -----
headFP
+ ^memory unsignedLong64At: address + 17!
- ^memory long64At: address + 17!
Item was changed:
----- Method: CogStackPageSurrogate64>>headFP: (in category 'accessing') -----
headFP: aValue
self assert: (address + 16 >= zoneBase and: [address + 23 < zoneLimit]).
+ ^memory unsignedLong64At: address + 17 put: aValue!
- ^memory long64At: address + 17 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate64>>headSP (in category 'accessing') -----
headSP
+ ^memory unsignedLong64At: address + 9!
- ^memory long64At: address + 9!
Item was changed:
----- Method: CogStackPageSurrogate64>>headSP: (in category 'accessing') -----
headSP: aValue
self assert: (address + 8 >= zoneBase and: [address + 15 < zoneLimit]).
+ ^memory unsignedLong64At: address + 9 put: aValue!
- ^memory long64At: address + 9 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate64>>lastAddress (in category 'accessing') -----
lastAddress
+ ^memory unsignedLong64At: address + 49!
- ^memory long64At: address + 49!
Item was changed:
----- Method: CogStackPageSurrogate64>>lastAddress: (in category 'accessing') -----
lastAddress: aValue
+ self assert: (address + 48 >= zoneBase and: [address + 55 < zoneLimit]).
+ ^memory unsignedLong64At: address + 49 put: aValue!
- self assert: (address + 48 >= zoneBase and: [address + 35 < zoneLimit]).
- ^memory long64At: address + 49 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate64>>nextPage (in category 'accessing') -----
nextPage
+ ^stackPages surrogateAtAddress: (memory unsignedLong64At: address + 65)!
- ^stackPages surrogateAtAddress: (memory long64At: address + 65)!
Item was changed:
----- Method: CogStackPageSurrogate64>>nextPage: (in category 'accessing') -----
nextPage: aValue
self assert: (address + 64 >= zoneBase and: [address + 71 < zoneLimit]).
+ memory unsignedLong64At: address + 65 put: aValue asInteger.
+ ^aValue!
- ^memory
- long64At: address + 65
- put: aValue asInteger!
Item was added:
+ ----- Method: CogStackPageSurrogate64>>padToWord (in category 'accessing') -----
+ padToWord
+ ^memory long64At: address + 65!
Item was added:
+ ----- Method: CogStackPageSurrogate64>>padToWord: (in category 'accessing') -----
+ padToWord: aValue
+ self assert: (address + 64 >= zoneBase and: [address + 71 < zoneLimit]).
+ ^memory long64At: address + 65 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate64>>prevPage (in category 'accessing') -----
prevPage
+ ^stackPages surrogateAtAddress: (memory unsignedLong64At: address + 73)!
- ^stackPages surrogateAtAddress: (memory long64At: address + 73)!
Item was changed:
----- Method: CogStackPageSurrogate64>>prevPage: (in category 'accessing') -----
prevPage: aValue
self assert: (address + 72 >= zoneBase and: [address + 79 < zoneLimit]).
+ memory unsignedLong64At: address + 73 put: aValue asInteger.
+ ^aValue!
- ^memory
- long64At: address + 73
- put: aValue asInteger!
Item was changed:
----- Method: CogStackPageSurrogate64>>realStackLimit (in category 'accessing') -----
realStackLimit
+ ^memory unsignedLong64At: address + 41!
- ^memory long64At: address + 41!
Item was changed:
----- Method: CogStackPageSurrogate64>>realStackLimit: (in category 'accessing') -----
realStackLimit: aValue
self assert: (address + 40 >= zoneBase and: [address + 47 < zoneLimit]).
+ ^memory unsignedLong64At: address + 41 put: aValue!
- ^memory long64At: address + 41 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate64>>stackLimit (in category 'accessing') -----
stackLimit
+ ^memory unsignedLong64At: address + 1!
- ^memory long64At: address + 1!
Item was changed:
----- Method: CogStackPageSurrogate64>>stackLimit: (in category 'accessing') -----
stackLimit: aValue
+ self assert: (address + 0 >= zoneBase and: [address + 7 < zoneLimit]).
+ ^memory unsignedLong64At: address + 1 put: aValue!
- self assert: (address >= zoneBase and: [address + 7 < zoneLimit]).
- ^memory long64At: address + 1 put: aValue!
Item was changed:
----- Method: CogStackPageSurrogate64>>trace (in category 'accessing') -----
trace
+ ^memory long64At: address + 57!
- ^memory longAt: address + 57!
Item was changed:
----- Method: CogStackPageSurrogate64>>trace: (in category 'accessing') -----
trace: aValue
+ self assert: (address + 56 >= zoneBase and: [address + 63 < zoneLimit]).
+ ^memory long64At: address + 57 put: aValue!
- self assert: (address + 56 >= zoneBase and: [address + 59 < zoneLimit]).
- ^memory longAt: address + 57 put: aValue!
Item was changed:
----- Method: CogVMSimulator>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
ceSendFromInLineCacheMiss: oPIC
"Override to map the address into a CogMethodSurrogate"
| surrogate |
surrogate := oPIC isInteger
ifTrue: [cogit cogMethodSurrogateAt: oPIC]
ifFalse: [oPIC].
self logSend: surrogate selector.
+ (surrogate cmNumArgs = 0
+ and: [(self stackValue: 1) = 16r8169D0
+ and: [self stackTop = 16r53EA7]]) ifTrue:
+ [self halt].
^super ceSendFromInLineCacheMiss: surrogate!
Item was changed:
----- Method: CogVMSimulator>>moveMethodCacheToMemoryAt: (in category 'initialization') -----
moveMethodCacheToMemoryAt: address
| oldMethodCache |
oldMethodCache := methodCache.
- self flag: 'broken for 64-bit VM because Bitmap access unit is 32-bits'.
"In the VM the methodCache is written as a normal array with 1-relative addressing.
In C this works by allocating an extra element in the methodCache array (see
class-side declareCVarsIn:). In simulation simply position the start of the methodCache
one word lower, achieving the same effect. -1 because CArrayAccessor is 0-relative
and adds 1 on accesses itself."
methodCache := CMethodCacheAccessor new
+ objectMemory: objectMemory
+ at: address
- memory: objectMemory memory
- offset: address / objectMemory wordSize
array: oldMethodCache
functionPointerIndex: MethodCachePrimFunction
entrySize: MethodCacheEntrySize.
+ self assert: address - objectMemory wordSize = self methodCacheAddress.
1 to: MethodCacheSize do:
[:i|
self assert: (methodCache at: i) = 0].
methodCache at: 1 put: 16rC4EC4.
+ self assert: (objectMemory longAt: address) = 16rC4EC4.
- self assert: (self longAt: address) = 16rC4EC4.
1 to: MethodCacheSize do:
[:i|
methodCache at: i put: (oldMethodCache at: i)]!
Item was changed:
----- Method: CogVMSimulator>>movePrimTraceLogToMemoryAt: (in category 'initialization') -----
movePrimTraceLogToMemoryAt: address
| oldTraceLog |
oldTraceLog := primTraceLog.
+ primTraceLog := CArrayOfLongsAccessor new
+ objectMemory: objectMemory at: address.
+ self assert: address = self primTraceLogAddress.
- self flag: 'broken for 64-bit VM because Bitmap access unit is 32-bits'.
- primTraceLog := CObjectAccessor new
- memory: objectMemory memory
- offset: address / objectMemory wordSize.
0 to: PrimTraceLogSize - 1 do:
[:i|
self assert: (primTraceLog at: i) = 0].
primTraceLog at: 0 put: 16rC4EC4.
+ self assert: (objectMemory longAt: address) = 16rC4EC4.
- self assert: (self longAt: address) = 16rC4EC4.
0 to: PrimTraceLogSize - 1 do:
[:i|
primTraceLog at: i put: (oldTraceLog at: i)]!
Item was changed:
----- Method: Cogit>>cCoerceSimple:to: (in category 'translation support') -----
cCoerceSimple: value to: cTypeString
<doNotGenerate>
+ cTypeString last == $* ifTrue:
+ [cTypeString == #'CogMethod *' ifTrue:
+ [^(value isInteger and: [value < 0])
+ ifTrue: [value] "it's an error code; leave it be"
+ ifFalse: [self cogMethodSurrogateAt: value asUnsignedInteger]].
+ cTypeString == #'CogBlockMethod *' ifTrue:
+ [^self cogBlockMethodSurrogateAt: value asUnsignedInteger].
+ cTypeString == #'NSSendCache *' ifTrue:
+ [^self nsSendCacheSurrogateAt: value asUnsignedInteger].
+ (cTypeString == #'AbstractInstruction *'
+ and: [value isBehavior]) ifTrue:
+ [^CogCompilerClass].
+ cTypeString == #'StackPage *' ifTrue:
+ [^coInterpreter stackPages surrogateAtAddress: value]].
- cTypeString == #'CogMethod *' ifTrue:
- [^(value isInteger and: [value < 0])
- ifTrue: [value] "it's an error code; leave it be"
- ifFalse: [self cogMethodSurrogateAt: value asUnsignedInteger]].
- cTypeString == #'CogBlockMethod *' ifTrue:
- [^self cogBlockMethodSurrogateAt: value asUnsignedInteger].
- cTypeString == #'NSSendCache *' ifTrue:
- [^self nsSendCacheSurrogateAt: value asUnsignedInteger].
- (cTypeString == #'AbstractInstruction *'
- and: [value isBehavior]) ifTrue:
- [^CogCompilerClass].
^super cCoerceSimple: value to: cTypeString!
Item was added:
+ ----- Method: Integer>>signedIntFromChar (in category '*VMMaker-interpreter simulator') -----
+ signedIntFromChar
+ "Self is an unsigned 8-bit integer in twos-comp form"
+
+ | shortBits |
+ shortBits := self bitAnd: 16rFF.
+ ^(self bitAnd: 16r80) "sign bit" = 0
+ ifTrue: [shortBits]
+ ifFalse: [shortBits - 16r100]!
Item was changed:
----- Method: Integer>>signedIntFromLong (in category '*VMMaker-interpreter simulator') -----
signedIntFromLong
"Self is a signed or unsigned 32-bit integer"
+ | bits |
+ (self >= -1073741824 and: [self <= 1073741823]) ifTrue: "These are known to be SmallIntegers..."
+ [^self].
+ bits := self bitAnd: 16rFFFFFFFF.
+ (bits digitAt: 4) <= 16r7F ifTrue: [^bits].
+ ^bits - 16r100000000!
- | sign |
- self < 0 ifTrue: [^self].
- sign := self bitAnd: 16r80000000.
- sign = 0 ifTrue: [^ self].
- ^ self - sign - sign!
Item was changed:
----- Method: Integer>>signedIntFromLong64 (in category '*VMMaker-interpreter simulator') -----
signedIntFromLong64
"Self is a signed or unsigned 64-bit integer"
+ | bits |
+ "This case is handled by the SmallInteger subclass..."
+ "(self >= -1073741824 and: [self <= 1073741823]) ifTrue:
+ [^self]."
+ bits := self bitAnd: 16rFFFFFFFFFFFFFFFF.
+ (bits digitAt: 8) <= 16r7F ifTrue: [^bits].
+ ^bits - 16r10000000000000000!
- | sign |
- self < 0 ifTrue: [^self].
- sign := self bitAnd: 16r8000000000000000.
- sign = 0 ifTrue: [^self].
- ^self - sign - sign!
Item was added:
+ ----- Method: Integer>>signedIntToChar (in category '*VMMaker-interpreter simulator') -----
+ signedIntToChar
+ "Produces an 8-bit value in twos-comp form. Truncates if out-of-range as per a C cast"
+
+ ^self bitAnd: 16rFF!
Item was changed:
----- Method: Integer>>signedIntToLong (in category '*VMMaker-interpreter simulator') -----
signedIntToLong
+ "Produces a 32-bit value in twos-comp form. Truncates if out-of-range as per a C cast"
- "Produces a 32-bit value in twos-comp form. Sorry no error checking"
+ ^self bitAnd: 16rFFFFFFFF!
- self >= 0
- ifTrue: [^ self]
- ifFalse: [^ self + 16r80000000 + 16r80000000]
- !
Item was changed:
----- Method: Integer>>signedIntToLong64 (in category '*VMMaker-interpreter simulator') -----
signedIntToLong64
+ "Produces a 64-bit value in twos-comp form. Truncates if out-of-range as per a C cast"
- "Produces a 64-bit value in twos-comp form. Sorry no error checking"
+ ^self bitAnd: 16rFFFFFFFFFFFFFFFF!
- self >= 0
- ifTrue: [^ self]
- ifFalse: [^ self + 16r8000000000000000 + 16r8000000000000000]
- !
Item was changed:
----- Method: Integer>>signedIntToShort (in category '*VMMaker-interpreter simulator') -----
signedIntToShort
+ "Produces a 16-bit value in twos-comp form. Truncates if out-of-range as per a C cast"
- "Produces a 16-bit value (0-65k) in twos-comp form. Sorry no error checking"
^self bitAnd: 16rFFFF!
Item was added:
+ ----- Method: SmallInteger>>signedIntFromLong64 (in category '*VMMaker-interpreter simulator') -----
+ signedIntFromLong64
+ "Self is a signed or unsigned 64-bit integer.
+ Currently SmallIntegers are either 31-bit (in the 32-bit implementation) or 61-bit
+ (in the 64-bit implementation) so save some time by overriding in the subclass."
+ ^self!
Item was added:
+ ----- Method: VMClass class>>openCogTestsMultiWindowBrowser (in category 'utilities') -----
+ openCogTestsMultiWindowBrowser
+ "Answer a new multi-window browser on the test classes in VMMaker"
+ "self openCogTestsMultiWindowBrowser"
+ | testClasses b |
+ testClasses := (PackageInfo named: 'VMMaker') classes select: [:c| c inheritsFrom: TestCase].
+ testClasses removeAll: AbstractInstructionTests allSubclasses.
+ testClasses removeAll: (testClasses select: [:c| '*Plugin*' match: c name]).
+ b := Browser open.
+ testClasses do:
+ [:class| b selectCategoryForClass: class; selectClass: class]
+ separatedBy:
+ [b multiWindowState addNewWindow].
+ b multiWindowState selectWindowIndex: 1!
Item was added:
+ ----- Method: VMClass class>>openCogitMultiWindowBrowser (in category 'utilities') -----
+ openCogitMultiWindowBrowser
+ "Answer a new multi-window browser on the ObjectMemory classes, the Cog Interpreter classes, and the main JIT classes"
+ "self openCogitMultiWindowBrowser"
+ | b |
+ b := Browser open.
+ Cogit withAllSubclasses,
+ CogObjectRepresentation withAllSubclasses,
+ {CogMethodZone. CogRTLOpcodes },
+ (CogAbstractInstruction withAllSubclasses reject: [:c| c name endsWith: 'Tests']),
+ {VMStructType. VMMaker. CCodeGenerator. TMethod}
+ do: [:class|
+ b selectCategoryForClass: class; selectClass: class]
+ separatedBy:
+ [b multiWindowState addNewWindow].
+ b multiWindowState selectWindowIndex: 1!
Item was added:
+ TestCase subclass: #VMMakerIntegerTests
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Tests'!
Item was added:
+ ----- Method: VMMakerIntegerTests>>testSignedIntFromFoo (in category 'tests') -----
+ testSignedIntFromFoo
+ self assert: 16r55 signedIntFromChar equals: 16r55.
+ self assert: 16r155 signedIntFromChar equals: 16r55.
+ self assert: 16rAA signedIntFromChar < 0.
+ self assert: (16rAA signedIntFromChar bitAnd: 16rFF) = 16rAA.
+
+ self assert: 16r5555 signedIntFromShort equals: 16r5555.
+ self assert: 16r15555 signedIntFromShort equals: 16r5555.
+ self assert: 16rAAAA signedIntFromShort < 0.
+ self assert: (16rAAAA signedIntFromShort bitAnd: 16rFFFF) = 16rAAAA.
+
+ self assert: 16r55555555 signedIntFromLong equals: 16r55555555.
+ self assert: 16r155555555 signedIntFromLong equals: 16r55555555.
+ self assert: 16rAAAAAAAA signedIntFromLong< 0.
+ self assert: (16rAAAAAAAA signedIntFromLong bitAnd: 16rFFFFFFFF) = 16rAAAAAAAA.
+
+ self assert: 16r5555555555555555 signedIntFromLong64 equals: 16r5555555555555555.
+ self assert: 16r15555555555555555 signedIntFromLong64 equals: 16r5555555555555555.
+ self assert: 16rAAAAAAAAAAAAAAAA signedIntFromLong64< 0.
+ self assert: (16rAAAAAAAAAAAAAAAA signedIntFromLong64 bitAnd: 16rFFFFFFFFFFFFFFFF) = 16rAAAAAAAAAAAAAAAA!
Item was added:
+ ----- Method: VMMakerIntegerTests>>testSignedIntToFoo (in category 'tests') -----
+ testSignedIntToFoo
+ #(16r55 -16r56 16r5555 -16r5556 16r55555555 -16r55555556 16r5555555555555555 -16r5555555555555556) do:
+ [:n|
+ n abs digitLength = 1 ifTrue:
+ [self assert: n signedIntToChar signedIntFromChar equals: n].
+ self assert: (n signedIntToChar signedIntFromChar bitAnd: 16rFF) equals: (n bitAnd: 16rFF).
+ n abs digitLength <= 2 ifTrue:
+ [self assert: n signedIntToShort signedIntFromShort equals: n].
+ self assert: (n signedIntToShort signedIntFromShort bitAnd: 16rFFFF) equals: (n bitAnd: 16rFFFF).
+ n abs digitLength <= 4 ifTrue:
+ [self assert: n signedIntToLong signedIntFromLong equals: n].
+ self assert: (n signedIntToLong signedIntFromLong bitAnd: 16rFFFFFFFF) equals: (n bitAnd: 16rFFFFFFFF).
+ n abs digitLength <= 8 ifTrue:
+ [self assert: n signedIntToLong64 signedIntFromLong64 equals: n].
+ self assert: (n signedIntToLong64 signedIntFromLong64 bitAnd: 16rFFFFFFFFFFFFFFFF) equals: (n bitAnd: 16rFFFFFFFFFFFFFFFF)]!
More information about the Vm-dev
mailing list