[Vm-dev] VM Maker: VMMaker.oscog-eem.339.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Aug 31 19:16:14 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.339.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.339
Author: eem
Time: 31 August 2013, 12:13:21.379 pm
UUID: 043d571b-d2cc-4e0b-b297-4358a4cf6801
Ancestors: VMMaker.oscog-eem.338
Fleshing-out of CogMemoryManager so that a first bootstrap of an
image's objects (*) to the new format can be completed. The
bootstrap is in the Cog package.
(*) this does not include compiling different versions of methods for
the new format, behavior hash management for the class table, or
immediate characters.
Add 32-bit & 64-bit subclasses of CogMemoryManager.
Abstract out unalignedAccessError.
Remove the unused ClassCompiledMethod and ClassProcess.
Fix comment typo.
=============== Diff against VMMaker.oscog-eem.335 ===============
Item was added:
+ CogMemoryManager32Bits subclass: #CMM32LSBSimulator
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-MemoryManagerSimulation'!
Item was added:
+ ----- Method: CMM32LSBSimulator>>endianness (in category 'memory access') -----
+ endianness
+ ^#little!
Item was added:
+ ----- Method: CMM32LSBSimulator>>headerForSlots:format:classIndex: (in category 'header format') -----
+ headerForSlots: numSlots format: formatField classIndex: classIndex
+ "The header format in LSB is
+ MSB: | 2 bits |
+ | 22: identityHash |
+ | 8: slotSize |
+ | 3 bits |
+ | 5: format |
+ | 2 bits |
+ | 22: classIndex | : LSB"
+ self assert: (numSlots between: 0 and: self slotSizeMask).
+ self assert: (formatField between: 0 and: 31).
+ self assert: (classIndex between: 0 and: 16r3fffff).
+ ^super headerForSlots: numSlots format: formatField classIndex: classIndex!
Item was added:
+ ----- Method: CMM32LSBSimulator>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+
+ ^self longAt: byteAddress put: a32BitValue!
Item was added:
+ ----- Method: CMM32LSBSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1!
Item was added:
+ ----- Method: CMM32LSBSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was added:
+ ----- Method: CMM32LSBSimulator>>longLongAt: (in category 'memory access') -----
+ longLongAt: byteAddress
+ | hiWord loWord |
+ byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ hiWord := memory at: byteAddress // 8 + 1.
+ loWord := memory at: byteAddress // 8 + 2.
+ ^hiWord = 0
+ ifTrue: [loWord]
+ ifFalse: [(hiWord bitShift: 32) + loWord]!
Item was added:
+ ----- Method: CMM32LSBSimulator>>longLongAt:put: (in category 'memory access') -----
+ longLongAt: byteAddress put: a64BitValue
+ byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ memory
+ at: byteAddress // 8 + 1 put: a64BitValue >> 32;
+ at: byteAddress // 8 + 2 put: (a64BitValue bitAnd: 16rffffffff).
+ ^a64BitValue!
Item was added:
+ ----- Method: CMM32LSBSimulator>>unalignedAccessError (in category 'memory access') -----
+ unalignedAccessError
+ ^self error: 'unaligned access'!
Item was changed:
----- Method: CoInterpreterStackPages>>longAt: (in category 'memory access') -----
longAt: byteAddress
"Note: Adjusted for Smalltalk's 1-based array indexing."
- self assert: (byteAddress bitAnd: BytesPerWord - 1) == 0.
self assert: (byteAddress >= minStackAddress and: [byteAddress < maxStackAddress]).
^objectMemory longAt: byteAddress!
Item was changed:
----- Method: CoInterpreterStackPages>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a32BitValue
- self assert: (byteAddress bitAnd: BytesPerWord - 1) == 0.
self assert: (byteAddress >= minStackAddress and: [byteAddress < maxStackAddress]).
^objectMemory longAt: byteAddress put: a32BitValue!
Item was changed:
VMClass subclass: #CogMemoryManager
(excessive size, no diff calculated)
Item was added:
+ ----- Method: CogMemoryManager>>allocateMemoryOfSize: (in category 'simulation') -----
+ allocateMemoryOfSize: limit
+ <doNotGenerate>
+ memory := (self endianness == #little
+ ifTrue: [LittleEndianBitmap]
+ ifFalse: [Bitmap]) new: (limit roundUpTo: 8).
+ freeStart := 0.
+ scavengeThreshold := newSpaceLimit := memory size * 4 "Bitmap is a 4-byte per word array"!
Item was added:
+ ----- Method: CogMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
+ allocateSlots: numSlots format: formatField classIndex: classIndex
+ self subclassResponsibility!
Item was added:
+ ----- Method: CogMemoryManager>>allocationUnit (in category 'allocation') -----
+ allocationUnit
+ "All objects are a multiple of 8 bytes in length"
+ ^8!
Item was added:
+ ----- Method: CogMemoryManager>>arrayClassIndexPun (in category 'class table') -----
+ arrayClassIndexPun
+ "Class puns are class indices not used by any class. There is an entry
+ for the pun that refers to the notional class of objects with this class
+ index. But because the index doesn't match the class it won't show up
+ in allInstances, hence hiding the object with a pun as its class index.
+ The puns occupy indices 16 through 31."
+ ^16!
Item was added:
+ ----- Method: CogMemoryManager>>arrayFormat (in category 'header format') -----
+ arrayFormat
+ ^2!
Item was added:
+ ----- Method: CogMemoryManager>>baseHeaderSize (in category 'header format') -----
+ baseHeaderSize
+ "Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow),
+ 16 bytes otherwise (slot size in preceeding word)."
+ ^8!
Item was added:
+ ----- Method: CogMemoryManager>>bytesPerSlot (in category 'header format') -----
+ bytesPerSlot
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: CogMemoryManager>>characterObjectOf: (in category 'object access') -----
+ characterObjectOf: characterCode
+ ^characterCode << self numTagBits + self characterTag!
Item was added:
+ ----- Method: CogMemoryManager>>characterTag (in category 'object access') -----
+ characterTag
+ ^2!
Item was added:
+ ----- Method: CogMemoryManager>>classIndexMask (in category 'header format') -----
+ classIndexMask
+ "22-bit class mask => ~ 4M classes"
+ ^16r3fffff!
Item was added:
+ ----- Method: CogMemoryManager>>classTableMajorIndexShift (in category 'class table') -----
+ classTableMajorIndexShift
+ "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages"
+ ^10!
Item was added:
+ ----- Method: CogMemoryManager>>classTableMinorIndexMask (in category 'class table') -----
+ classTableMinorIndexMask
+ "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages"
+ "self basicNew classTableMinorIndexMask"
+ ^1 << self classTableMajorIndexShift - 1!
Item was added:
+ ----- Method: CogMemoryManager>>classTablePageSize (in category 'class table') -----
+ classTablePageSize
+ "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages"
+ "self basicNew classTablePageSize"
+ ^1 << self classTableMajorIndexShift!
Item was added:
+ ----- Method: CogMemoryManager>>classTableRootObj (in category 'accessing') -----
+ classTableRootObj
+ "For mapInterpreterOops & bootstrap"
+ ^classTableRootObj!
Item was added:
+ ----- Method: CogMemoryManager>>classTableRootObj: (in category 'accessing') -----
+ classTableRootObj: anOop
+ "For mapInterpreterOops"
+ classTableRootObj := anOop!
Item was added:
+ ----- Method: CogMemoryManager>>fetchLong32:ofObject: (in category 'object access') -----
+ fetchLong32: fieldIndex ofObject: oop
+ "index by 32-bit units, and return a 32-bit value. Intended to replace fetchWord:ofObject:"
+
+ ^self long32At: oop + self baseHeaderSize + (fieldIndex << 2)!
Item was added:
+ ----- Method: CogMemoryManager>>formatMask (in category 'header format') -----
+ formatMask
+ ^16r1f!
Item was added:
+ ----- Method: CogMemoryManager>>formatOf: (in category 'object access') -----
+ formatOf: objOop
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: CogMemoryManager>>formatShift (in category 'header format') -----
+ formatShift
+ ^24!
Item was added:
+ ----- Method: CogMemoryManager>>headerForSlots:format:classIndex: (in category 'header format') -----
+ headerForSlots: numSlots format: formatField classIndex: classIndex
+ "The header format in LSB is
+ MSB: | 8: slotSize | (on a byte boundary)
+ | 2 bits |
+ | 22: identityHash | (on a word boundary)
+ | 3 bits |
+ | 5: format | (on a byte boundary)
+ | 2 bits |
+ | 22: classIndex | (on a word boundary) : LSB
+ The remaining bits (7) need to be used for
+ isGrey
+ isMarked
+ isRemembered
+ isPinned
+ isImmutable
+ leaving 2 unused bits."
+ ^ (numSlots << 56)
+ + (formatField << 24)
+ + classIndex!
Item was added:
+ ----- Method: CogMemoryManager>>identityHashHalfWordMask (in category 'header format') -----
+ identityHashHalfWordMask
+ ^16r3fffff!
Item was added:
+ ----- Method: CogMemoryManager>>isCompiledMethod: (in category 'object testing') -----
+ isCompiledMethod: objOop
+ "Answer whether the argument object is of compiled method format"
+ <api>
+ ^(self formatOf: objOop) >= 24!
Item was added:
+ ----- Method: CogMemoryManager>>isPointersNonImm: (in category 'object testing') -----
+ isPointersNonImm: objOop
+ ^(self formatOf: objOop) <= 5!
Item was added:
+ ----- Method: CogMemoryManager>>nilFieldsOf: (in category 'primitive support') -----
+ nilFieldsOf: obj
+ 0 to: (self rawSlotSizeOf: obj) - 1 do:
+ [:i|
+ self storePointerUnchecked: i ofObject: obj withValue: nilObj]!
Item was added:
+ ----- Method: CogMemoryManager>>nilObject (in category 'accessing') -----
+ nilObject
+ ^nilObj!
Item was added:
+ ----- Method: CogMemoryManager>>nilObject: (in category 'accessing') -----
+ nilObject: anOop
+ "For mapInterpreterOops"
+ nilObj := anOop!
Item was added:
+ ----- Method: CogMemoryManager>>numTagBits (in category 'object access') -----
+ numTagBits
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: CogMemoryManager>>rawSlotSizeOf: (in category 'object access') -----
+ rawSlotSizeOf: oop
+ <returnTypeC: #usqInt>
+ | header slotSize |
+ header := self longAt: oop.
+ slotSize := header >> self slotSizeHalfWordShift bitAnd: self slotSizeMask.
+ ^slotSize = self slotSizeMask
+ ifTrue: [self cCoerceSimple: (self longLongAt: oop - self baseHeaderSize) to: #usqInt]
+ ifFalse: [slotSize]!
Item was added:
+ ----- Method: CogMemoryManager>>setHashBitsOf:to: (in category 'header access') -----
+ setHashBitsOf: objOop to: hash
+ self assert: (hash between: 0 and: self identityHashHalfWordMask).
+ self longAt: objOop
+ put: ((self longAt: objOop) bitClear: self identityHashHalfWordMask) + hash!
Item was added:
+ ----- Method: CogMemoryManager>>slotSizeHalfWordShift (in category 'header format') -----
+ slotSizeHalfWordShift
+ ^24!
Item was added:
+ ----- Method: CogMemoryManager>>slotSizeMask (in category 'header format') -----
+ slotSizeMask
+ "8-bit slot size:
+ max 64-bit small obj size 254 * 8 = 2032 bytes
+ max 32-bit small obj size 254 * 4 = 1016 bytes"
+ ^255!
Item was added:
+ ----- Method: CogMemoryManager>>storeLong32:ofObject:withValue: (in category 'object access') -----
+ storeLong32: fieldIndex ofObject: obj withValue: valueWord
+ ^self long32At: obj + self baseHeaderSize + (fieldIndex << 2) put: valueWord!
Item was added:
+ ----- Method: CogMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') -----
+ storePointer: fieldIndex ofObject: oop withValue: valuePointer
+ "Note must check here for stores of young objects into old ones."
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: CogMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
+ storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: CogMemoryManager>>weakArrayClassIndexPun (in category 'class table') -----
+ weakArrayClassIndexPun
+ "Class puns are class indices not used by any class. There is an entry
+ for the pun that refers to the notional class of objects with this class
+ index. But because the index doesn't match the class it won't show up
+ in allInstances, hence hiding the object with a pun as its class index.
+ The puns occupy indices 16 through 31."
+ ^17!
Item was added:
+ ----- Method: CogMemoryManager>>weakArrayFormat (in category 'header format') -----
+ weakArrayFormat
+ ^4!
Item was added:
+ CogMemoryManager subclass: #CogMemoryManager32Bits
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-MemoryManager'!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>allocateSlots:format:classIndex: (in category 'allocation') -----
+ allocateSlots: numSlots format: formatField classIndex: classIndex
+ | numBytes newObj |
+ "Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow),
+ 16 bytes otherwise (slot size in preceeding word).
+ Objects always have at least one slot, for the forwarding pointer,
+ and are multiples of 8 bytes in length."
+ numSlots >= self slotSizeMask
+ ifTrue:
+ [newObj := freeStart + self baseHeaderSize.
+ numBytes := self baseHeaderSize + self baseHeaderSize "double header"
+ + numSlots + (numSlots bitAnd: 1) * self bytesPerSlot] "roundTo allocationUnit"
+ ifFalse:
+ [newObj := freeStart.
+ numBytes := self baseHeaderSize "single header"
+ + (numSlots <= 1
+ ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
+ ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit"
+ self assert: numBytes \\ self allocationUnit = 0.
+ freeStart + numBytes > scavengeThreshold ifTrue:
+ [freeStart + numBytes > newSpaceLimit ifTrue:
+ [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex].
+ self scheduleScavenge].
+ numSlots >= self slotSizeMask
+ ifTrue:
+ [self longLongAt: freeStart put: numSlots.
+ self longLongAt: newObj put: (self headerForSlots: self slotSizeMask format: formatField classIndex: classIndex)]
+ ifFalse:
+ [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
+ freeStart := freeStart + numBytes.
+ ^newObj!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>bytesPerSlot (in category 'header format') -----
+ bytesPerSlot
+ ^4!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: fieldIndex ofObject: objOop
+ ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>formatOf: (in category 'object access') -----
+ formatOf: objOop
+ ^(self longAt: objOop + self wordSize) >> self formatShift bitAnd: self formatMask!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>numTagBits (in category 'object access') -----
+ numTagBits
+ ^2!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>shiftForWord (in category 'word size') -----
+ shiftForWord
+ ^2!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>storePointer:ofObject:withValue: (in category 'object access') -----
+ storePointer: fieldIndex ofObject: oop withValue: valuePointer
+ "Note must check here for stores of young objects into old ones."
+
+ (self oop: oop isLessThan: newSpaceLimit) ifFalse: "most stores into young objects"
+ [(self isImmediate: valuePointer) ifFalse:
+ [(self oop: valuePointer isLessThan: newSpaceLimit) ifTrue:
+ [self possibleRootStoreInto: oop value: valuePointer]]].
+
+ ^self
+ longAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ put: valuePointer!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
+ storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
+ ^self
+ longAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ put: valuePointer!
Item was added:
+ ----- Method: CogMemoryManager32Bits>>wordSize (in category 'word size') -----
+ wordSize
+ ^4!
Item was added:
+ CogMemoryManager subclass: #CogMemoryManager64Bits
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-MemoryManager'!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>allocateSlots:format:classIndex: (in category 'allocation') -----
+ allocateSlots: numSlots format: formatField classIndex: classIndex
+ | numBytes newObj |
+ "Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow),
+ 16 bytes otherwise (slot size in preceeding word).
+ Objects always have at least one slot, for the forwarding pointer,
+ and are multiples of 8 bytes in length."
+ numSlots >= self slotSizeMask
+ ifTrue:
+ [newObj := freeStart + self baseHeaderSize.
+ numBytes := (self baseHeaderSize + self baseHeaderSize) "double header"
+ + (numSlots * self bytesPerSlot)]
+ ifFalse:
+ [newObj := freeStart.
+ numBytes := self baseHeaderSize "single header"
+ + (numSlots < 1
+ ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
+ ifFalse: [numSlots * self bytesPerSlot])].
+
+ freeStart + numBytes > scavengeThreshold ifTrue:
+ [freeStart + numBytes > newSpaceLimit ifTrue:
+ [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex].
+ self scheduleScavenge].
+ numSlots >= self slotSizeMask
+ ifTrue:
+ [self longLongAt: freeStart put: numSlots.
+ self longLongAt: newObj put: (self headerForSlots: self slotSizeMask format: formatField classIndex: classIndex)]
+ ifFalse:
+ [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
+ freeStart := freeStart + numBytes.
+ ^newObj!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>bytesPerSlot (in category 'header format') -----
+ bytesPerSlot
+ ^8!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: fieldIndex ofObject: objOop
+ ^self longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>formatOf: (in category 'object access') -----
+ formatOf: objOop
+ ^(self longLongAt: objOop) >> self formatShift bitAnd: self formatMask!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>numTagBits (in category 'object access') -----
+ numTagBits
+ "4th bit reserved for object alignment, which could imply e.g. what space the object is in."
+ ^3!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>shiftForWord (in category 'word size') -----
+ shiftForWord
+ ^3!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>storePointer:ofObject:withValue: (in category 'object access') -----
+ storePointer: fieldIndex ofObject: oop withValue: valuePointer
+ "Note must check here for stores of young objects into old ones."
+
+ (self oop: oop isLessThan: newSpaceLimit) ifFalse: "most stores into young objects"
+ [(self isImmediate: valuePointer) ifFalse:
+ [(self oop: valuePointer isLessThan: newSpaceLimit) ifTrue:
+ [self possibleRootStoreInto: oop value: valuePointer]]].
+
+ ^self
+ longLongAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ put: valuePointer!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
+ storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
+ ^self
+ longLongAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ put: valuePointer!
Item was added:
+ ----- Method: CogMemoryManager64Bits>>wordSize (in category 'word size') -----
+ wordSize
+ ^8!
Item was changed:
----- Method: InterpreterSimulator>>longPrint: (in category 'debug support') -----
longPrint: oop
| lastPtr val lastLong hdrType prevVal |
(self isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
^ String streamContents:
[:strm |
lastPtr := 64*BytesPerWord min: (self lastPointerOf: oop).
hdrType := self headerType: oop.
hdrType = 2 ifTrue: [lastPtr := 0].
prevVal := 0.
(self headerStart: oop) to: lastPtr by: BytesPerWord do:
[:a | val := self longAt: oop+a.
(a > 0 and: [(val = prevVal) & (a ~= lastPtr)])
ifTrue:
[prevVal = (self longAt: oop+a-(BytesPerWord*2)) ifFalse: [strm cr; nextPutAll: ' ...etc...']]
ifFalse:
[strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space; nextPutAll: val hex8; space; space.
a = (BytesPerWord*2) negated ifTrue:
[strm nextPutAll: 'size = ' , (val - hdrType) hex].
a = BytesPerWord negated ifTrue:
[strm nextPutAll: '<' , (self nameOfClass: (val - hdrType)) , '>'].
a = 0 ifTrue: [strm cr; tab; nextPutAll: (self dumpHeader: val)].
a > 0 ifTrue: [strm nextPutAll: (self shortPrint: val)].
a = BytesPerWord ifTrue:
+ [(self isCompiledMethod: oop) ifTrue:
+ [strm cr; tab; nextPutAll: (self dumpMethodHeader: val)]]].
- [(self fetchClassOf: oop) = (self splObj: ClassCompiledMethod) ifTrue:
- [strm cr; tab; nextPutAll: (self dumpMethodHeader: val)]]].
prevVal := val].
lastLong := 256 min: (self sizeBitsOf: oop) - BaseHeaderSize.
hdrType = 2
ifTrue:
["free" strm cr; nextPutAll: (oop+(self longAt: oop)-2) hex;
space; space; nextPutAll: (oop+(self longAt: oop)-2) printString]
ifFalse:
[(self formatOf: oop) = 3
ifTrue:
[strm cr; tab; nextPutAll: '/ next 3 fields are above SP... /'.
lastPtr+BytesPerWord to: lastPtr+(3*BytesPerWord) by: BytesPerWord do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: a hex;
space; space; space; nextPutAll: val hex8; space; space.
(self validOop: val) ifTrue: [strm nextPutAll: (self shortPrint: val)]]]
ifFalse:
[lastPtr+BytesPerWord to: lastLong by: BytesPerWord do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space.
strm nextPutAll: val hex8; space; space;
nextPutAll: (self charsOfLong: val)]]].
]!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>longAt: (in category 'memory access') -----
longAt: byteAddress
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1!
- byteAddress \\ 4 ~= 0 ifTrue: [self error: 'unaligned access'].
- ^memory at: (byteAddress // 4) + 1!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a32BitValue
- "(byteAddress = 16r1896A50
- and: [a32BitValue = 7]) ifTrue:
- [self halt]."
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1 put: a32BitValue!
- byteAddress \\ 4 ~= 0 ifTrue: [self error: 'unaligned access'].
- ^memory at: (byteAddress // 4) + 1 put: a32BitValue!
Item was changed:
----- Method: NewObjectMemorySimulator>>longAt: (in category 'memory access') -----
longAt: byteAddress
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1!
- byteAddress \\ 4 ~= 0 ifTrue: [self error: 'unaligned access'].
- ^memory at: (byteAddress // 4) + 1!
Item was changed:
----- Method: NewObjectMemorySimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a32BitValue
- "(byteAddress = 16r1896A50
- and: [a32BitValue = 7]) ifTrue:
- [self halt]."
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ ^memory at: byteAddress // 4 + 1 put: a32BitValue!
- byteAddress \\ 4 ~= 0 ifTrue: [self error: 'unaligned access'].
- ^memory at: (byteAddress // 4) + 1 put: a32BitValue!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>longPrint: (in category 'debug support') -----
longPrint: oop
| lastPtr val lastLong hdrType prevVal |
(self isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
^ String streamContents:
[:strm |
lastPtr := 64*BytesPerWord min: (self lastPointerOf: oop).
hdrType := self headerType: oop.
hdrType = 2 ifTrue: [lastPtr := 0].
prevVal := 0.
(self headerStart: oop) to: lastPtr by: BytesPerWord do:
[:a | val := self longAt: oop+a.
(a > 0 and: [(val = prevVal) & (a ~= lastPtr)])
ifTrue:
[prevVal = (self longAt: oop+a-(BytesPerWord*2)) ifFalse: [strm cr; nextPutAll: ' ...etc...']]
ifFalse:
[strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space; nextPutAll: val hex8; space; space.
a = (BytesPerWord*2) negated ifTrue:
[strm nextPutAll: 'size = ' , (val - hdrType) hex].
a = BytesPerWord negated ifTrue:
[strm nextPutAll: '<' , (self nameOfClass: (val - hdrType)) , '>'].
a = 0 ifTrue: [strm cr; tab; nextPutAll: (self dumpHeader: val)].
a > 0 ifTrue: [strm nextPutAll: (self shortPrint: val)].
a = BytesPerWord ifTrue:
+ [(self isCompiledMethod: oop) ifTrue:
+ [strm cr; tab; nextPutAll: (self dumpMethodHeader: val)]]].
- [(self fetchClassOf: oop) = (self splObj: ClassCompiledMethod) ifTrue:
- [strm cr; tab; nextPutAll: (self dumpMethodHeader: val)]]].
prevVal := val].
lastLong := 256 min: (self sizeBitsOf: oop) - BaseHeaderSize.
hdrType = 2
ifTrue:
["free" strm cr; nextPutAll: (oop+(self longAt: oop)-2) hex;
space; space; nextPutAll: (oop+(self longAt: oop)-2) printString]
ifFalse:
[(self formatOf: oop) = 3
ifTrue:
[strm cr; tab; nextPutAll: '/ next 3 fields are above SP... /'.
lastPtr+BytesPerWord to: lastPtr+(3*BytesPerWord) by: BytesPerWord do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: a hex;
space; space; space; nextPutAll: val hex8; space; space.
(self validOop: val) ifTrue: [strm nextPutAll: (self shortPrint: val)]]]
ifFalse:
[lastPtr+BytesPerWord to: lastLong by: BytesPerWord do:
[:a | val := self longAt: oop+a.
strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
space; space; space.
strm nextPutAll: val hex8; space; space;
nextPutAll: (self charsOfLong: val)]]].
]!
Item was changed:
----- Method: ObjectMemory class>>initializeSpecialObjectIndices (in category 'initialization') -----
initializeSpecialObjectIndices
"Initialize indices into specialObjects array."
NilObject := 0.
FalseObject := 1.
TrueObject := 2.
SchedulerAssociation := 3.
ClassBitmap := 4.
ClassInteger := 5.
ClassByteString := ClassString := 6. "N.B. Actually class ByteString"
ClassArray := 7.
"SmalltalkDictionary := 8." "Do not delete!!"
ClassFloat := 9.
ClassMethodContext := 10.
ClassBlockContext := 11.
ClassPoint := 12.
ClassLargePositiveInteger := 13.
TheDisplay := 14.
ClassMessage := 15.
+ "ClassCompiledMethod := 16. unused by the VM"
- ClassCompiledMethod := 16.
TheLowSpaceSemaphore := 17.
ClassSemaphore := 18.
ClassCharacter := 19.
SelectorDoesNotUnderstand := 20.
SelectorCannotReturn := 21.
ProcessSignalingLowSpace := 22. "was TheInputSemaphore"
SpecialSelectors := 23.
CharacterTable := 24.
SelectorMustBeBoolean := 25.
ClassByteArray := 26.
+ "ClassProcess := 27. unused"
- ClassProcess := 27.
CompactClasses := 28.
TheTimerSemaphore := 29.
TheInterruptSemaphore := 30.
SelectorCannotInterpret := 34.
"Was MethodContextProto := 35."
ClassBlockClosure := 36.
"Was BlockContextProto := 37."
ExternalObjectsArray := 38.
ClassMutex := 39.
"Was: ClassTranslatedMethod := 40."
ProcessInExternalCodeTag := 40.
TheFinalizationSemaphore := 41.
ClassLargeNegativeInteger := 42.
ClassExternalAddress := 43.
ClassExternalStructure := 44.
ClassExternalData := 45.
ClassExternalFunction := 46.
ClassExternalLibrary := 47.
SelectorAboutToReturn := 48.
SelectorRunWithIn := 49.
SelectorAttemptToAssign := 50.
"PrimErrTableIndex := 51. in Interpreter class>>initializePrimitiveErrorCodes"
ClassAlien := 52.
SelectorInvokeCallback := 53.
ClassUnsafeAlien := 54.
ClassWeakFinalizer := 55.
ForeignCallbackProcess := 56.
SelectorUnknownBytecode := 57.
SelectorCounterTripped := 58
!
Item was changed:
----- Method: RePlugin>>primPCREExecfromto (in category 're primitives') -----
primPCREExecfromto
+ "<rcvr primPCREExec: searchObject from: fromInteger to: toInteger>, where rcvr is an object with instance variables:
- "<rcvr primPCREExec: searchObject> from: fromInteger to: toInteger>, where rcvr is an object with instance variables:
'patternStr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags'
Apply the regular expression (stored in <pcrePtr> and <extratr>, generated from calls to primPCRECompile), to smalltalk String searchObject using <matchOptions>, beginning at offset <fromInteger> and continuing until offset <toInteger>. If there is no match, answer nil. Otherwise answer a ByteArray of offsets representing the results of the match."
| searchObject searchBuffer length result matchSpacePtr matchSpaceSize fromInteger toInteger |
<export: true>
<var:#searchBuffer type: 'char *'>
<var:#matchSpacePtr type: 'int *'>
"Load Parameters"
toInteger := interpreterProxy stackIntegerValue: 0.
fromInteger := interpreterProxy stackIntegerValue: 1.
searchObject := interpreterProxy stackObjectValue: 2.
searchBuffer := interpreterProxy arrayValueOf: searchObject.
length := interpreterProxy byteSizeOf: searchObject.
self loadRcvrFromStackAt: 3.
"Validate parameters"
interpreterProxy success: (1 <= fromInteger).
interpreterProxy success: (toInteger<=length).
fromInteger := fromInteger - 1. "Smalltalk offsets are 1-based"
interpreterProxy success: (fromInteger<=toInteger).
"adjust length, searchBuffer"
length := toInteger - fromInteger.
searchBuffer := searchBuffer + fromInteger.
"Load Instance Variables"
pcrePtr := self rcvrPCREBufferPtr.
extraPtr := self rcvrExtraPtr.
matchFlags := self rcvrMatchFlags.
matchSpacePtr := self rcvrMatchSpacePtr.
matchSpaceSize := self rcvrMatchSpaceSize.
interpreterProxy failed ifTrue:[^ nil].
result := self
cCode: 'pcre_exec((pcre *)pcrePtr, (pcre_extra *)extraPtr,
searchBuffer, length, 0, matchFlags, matchSpacePtr, matchSpaceSize)'.
+ interpreterProxy pop: 4; pushInteger: result.
- interpreterProxy pop: 2; pushInteger: result.
"empty call so compiler doesn't bug me about variables not used"
self touch: searchBuffer; touch: matchSpacePtr; touch: matchSpaceSize; touch: length
!
Item was changed:
----- Method: RePlugin>>primPCRENumSubPatterns (in category 're primitives') -----
primPCRENumSubPatterns
"<rcvr primPCRENumSubPatterns>, where rcvr is an object with instance variables:
'patternStr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags'
Return the number of subpatterns captured by the compiled pattern."
<export: true>
+ | ncap |
-
"Load Parameters"
self loadRcvrFromStackAt: 0.
"Load Instance Variables"
pcrePtr := self rcvrPCREBufferPtr.
+ self cCode: 'pcre_fullinfo((const pcre *)pcrePtr, NULL, PCRE_INFO_CAPTURECOUNT, &ncap)'
+ inSmalltalk: [ncap := -1].
+ interpreterProxy pop: 1; pushInteger: ncap.
- interpreterProxy pop: 1; pushInteger: (self cCode: 'pcre_info((pcre *)pcrePtr, NULL, NULL)').
!
Item was changed:
----- Method: StackInterpreterSimulator>>openOn:extraMemory: (in category 'initialization') -----
openOn: fileName extraMemory: extraBytes
+ "StackInterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
- "InterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
| f version headerSize count oldBaseAddr bytesToShift swapBytes
hdrNumStackPages hdrEdenBytes headerFlags |
"open image file and read the header"
["begin ensure block..."
f := FileStream readOnlyFileNamed: fileName.
imageName := f fullName.
f binary.
version := self nextLongFrom: f. "current version: 16r1968 (=6504) vive la revolucion!!"
(self readableFormat: version)
ifTrue: [swapBytes := false]
ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion
ifTrue: [swapBytes := true]
ifFalse: [self error: 'incomaptible image format']].
headerSize := self nextLongFrom: f swap: swapBytes.
objectMemory setEndOfMemory: (self nextLongFrom: f swap: swapBytes). "first unused location in heap"
oldBaseAddr := self nextLongFrom: f swap: swapBytes. "object memory base address of image"
objectMemory specialObjectsOop: (self nextLongFrom: f swap: swapBytes).
objectMemory lastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
savedWindowSize := self nextLongFrom: f swap: swapBytes.
headerFlags := self nextLongFrom: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self nextLongFrom: f swap: swapBytes.
hdrNumStackPages := self nextShortFrom: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n"
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
stackPages := self stackPagesClass new. "Temporary for computeStackZoneSize"
"pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
Preserve it to be polite to images run on Cog."
theUnknownShort := self getShortFromFile: f swap: swapBytes.
hdrEdenBytes := self nextLongFrom: f swap: swapBytes.
objectMemory edenBytes: (hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]).
desiredEdenBytes := hdrEdenBytes.
"allocate interpreter memory"
objectMemory setMemoryLimit: objectMemory endOfMemory + extraBytes + objectMemory edenBytes + self interpreterAllocationReserveBytes.
"read in the image in bulk, then swap the bytes if necessary"
f position: headerSize.
objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
count := f readInto: objectMemory memory startingAt: 1 count: objectMemory endOfMemory // 4.
count ~= (objectMemory endOfMemory // 4) ifTrue: [self halt].
]
ensure: [f close].
self ensureImageFormatIsUpToDate: swapBytes.
objectMemory initialize.
bytesToShift := objectMemory startOfMemory - oldBaseAddr. "adjust pointers for zero base address"
Utilities informUser: 'Relocating object pointers...'
during: [self initializeInterpreter: bytesToShift].
!
Item was added:
+ ----- Method: VMClass>>unalignedAccessError (in category 'simulation') -----
+ unalignedAccessError
+ ^self error: 'unaligned access'!
Item was changed:
SharedPool subclass: #VMObjectIndices
instanceVariableNames: ''
+ classVariableNames: 'ActiveProcessIndex CharacterTable CharacterValueIndex ClassAlien ClassArray ClassBitmap ClassBlockClosure ClassBlockContext ClassByteArray ClassByteString ClassCharacter ClassExternalAddress ClassExternalData ClassExternalFunction ClassExternalLibrary ClassExternalStructure ClassFloat ClassInteger ClassLargeNegativeInteger ClassLargePositiveInteger ClassMessage ClassMethodContext ClassMutex ClassPoint ClassSemaphore ClassString ClassUnsafeAlien ClassWeakFinalizer ClosureCopiedValuesIndex ClosureFirstCopiedValueIndex ClosureIndex ClosureNumArgsIndex ClosureOuterContextIndex ClosureStartPCIndex CompactClasses ConstMinusOne ConstOne ConstTwo ConstZero ExcessSignalsIndex ExternalObjectsArray FalseObject FirstLinkIndex ForeignCallbackProcess HeaderIndex InstanceSpecificationIndex InstructionPointerIndex KeyIndex LastLinkIndex LiteralStart MessageArgumentsIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodDictionaryIndex MethodIndex MyListIndex NextLinkIndex NilObject PrimErrTableIndex PriorityIndex ProcessInExternalCodeTag ProcessListsIndex ProcessSignalingLowSpace ReceiverIndex SchedulerAssociation SelectorAboutToReturn SelectorAttemptToAssign SelectorCannotInterpret SelectorCannotReturn SelectorCounterTripped SelectorDoesNotUnderstand SelectorInvokeCallback SelectorMustBeBoolean SelectorRunWithIn SelectorStart SelectorUnknownBytecode SenderIndex SpecialSelectors StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TheDisplay TheFinalizationSemaphore TheInputSemaphore TheInterruptSemaphore TheLowSpaceSemaphore TheTimerSemaphore TrueObject ValueIndex XIndex YIndex'
- classVariableNames: 'ActiveProcessIndex CharacterTable CharacterValueIndex ClassAlien ClassArray ClassBitmap ClassBlockClosure ClassBlockContext ClassByteArray ClassByteString ClassCharacter ClassCompiledMethod ClassExternalAddress ClassExternalData ClassExternalFunction ClassExternalLibrary ClassExternalStructure ClassFloat ClassInteger ClassLargeNegativeInteger ClassLargePositiveInteger ClassMessage ClassMethodContext ClassMutex ClassPoint ClassProcess ClassSemaphore ClassString ClassUnsafeAlien ClassWeakFinalizer ClosureCopiedValuesIndex ClosureFirstCopiedValueIndex ClosureIndex ClosureNumArgsIndex ClosureOuterContextIndex ClosureStartPCIndex CompactClasses ConstMinusOne ConstOne ConstTwo ConstZero ExcessSignalsIndex ExternalObjectsArray FalseObject FirstLinkIndex ForeignCallbackProcess HeaderIndex InstanceSpecificationIndex InstructionPointerIndex KeyIndex LastLinkIndex LiteralStart MessageArgumentsIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodDictionaryIndex MethodIndex MyListIndex NextLinkIndex NilObject PrimErrTableIndex PriorityIndex ProcessInExternalCodeTag ProcessListsIndex ProcessSignalingLowSpace ReceiverIndex SchedulerAssociation SelectorAboutToReturn SelectorAttemptToAssign SelectorCannotInterpret SelectorCannotReturn SelectorCounterTripped SelectorDoesNotUnderstand SelectorInvokeCallback SelectorMustBeBoolean SelectorRunWithIn SelectorStart SelectorUnknownBytecode SenderIndex SpecialSelectors StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TheDisplay TheFinalizationSemaphore TheInputSemaphore TheInterruptSemaphore TheLowSpaceSemaphore TheTimerSemaphore TrueObject ValueIndex XIndex YIndex'
poolDictionaries: ''
category: 'VMMaker-Interpreter'!
!VMObjectIndices commentStamp: '<historical>' prior: 0!
I am a shared pool for the constants that define object layout and well-known objects shared between the object memories (e.g. ObjectMemory, NewObjectMemory), the interpreters (e.g. StackInterpreter, CoInterpreter) and the object representations (e.g. ObjectRepresentationForSqueakV3).
self classPool declare: #Foo from: StackInterpreter classPool
(ObjectMemory classPool keys select: [:k| (k beginsWith: 'Class') and: [(k endsWith: 'Index') not]]) do:
[:k| self classPool declare: k from: ObjectMemory classPool]!
More information about the Vm-dev
mailing list