[Vm-dev] VM Maker: VMMaker.oscog-eem.1492.mcz

Eliot Miranda eliot.miranda at gmail.com
Mon Oct 19 12:51:24 UTC 2015


Hi Rob,

> On Oct 17, 2015, at 9:29 PM, Robert Withers <robert.w.withers at gmail.com> wrote:
> 
> I think I have a 32-bit ubuntu install so these changes may not make a difference. Although, would I be able to run 64-bit images in the simulator on a 32-bit machine? That would be very cool.

Of course you can.  That's how the 64-bit Spur VM is being developed.  If you build the BochsX64Plugin you can also start to run the x64 JIT, but only start because it's not finished yet :-)

> 
> I would still be interested in building the latest VMMaker generated code in Pharo. In search of training and guidance, is there a write up on which packages to load (Cog, Cog.pharo, CogVMMakerPharoCompatibility, VMMaker.oscog, ...)?

 Ask Esteban.  But I don't understand what you mean by "building the latest VMMaker generated code in Pharo". Do you mean loading VMMaker or VMMaker.oscog into Pharo and running the simulator?

> 
> thank you,
> Robert
> 
>> On 10/18/2015 12:33 AM, commits at source.squeak.org wrote:
>> 
>> 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