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. 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, ...)? thank you, Robert On 10/18/2015 12:33 AM, commits@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)]!