David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.330.mcz
==================== Summary ====================
Name: VMMaker-dtl.330 Author: dtl Time: 26 November 2013, 9:33:55.06 pm UUID: 4dabd4f4-3bed-4c10-9c4e-4bfa69037719 Ancestors: VMMaker-dtl.329
Fix loading of format 6505 (Cog) images in InterpreterSimulator in float word order fixup. An interpreter must send #lengthOf:baseHeader:format: to its object memory, not to self.
No change to generated code, so versionString is unchanged.
=============== Diff against VMMaker-dtl.329 ===============
Item was changed: ----- Method: Interpreter>>install:inAtCache:at:string: (in category 'indexing primitives') ----- install: rcvr inAtCache: cache at: atIx string: stringy "Install the oop of this object in the given cache (at or atPut), along with its size, format and fixedSize" | hdr fmt totalLength fixedFields | <var: #cache type: 'sqInt *'>
hdr := objectMemory baseHeader: rcvr. fmt := (hdr >> 8) bitAnd: 16rF. (fmt = 3 and: [self isContextHeader: hdr]) ifTrue: ["Contexts must not be put in the atCache, since their size is not constant" ^ self primitiveFail]. + totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt. - totalLength := self lengthOf: rcvr baseHeader: hdr format: fmt. fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
cache at: atIx+AtCacheOop put: rcvr. stringy ifTrue: [cache at: atIx+AtCacheFmt put: fmt + 16] "special flag for strings" ifFalse: [cache at: atIx+AtCacheFmt put: fmt]. cache at: atIx+AtCacheFixedFields put: fixedFields. cache at: atIx+AtCacheSize put: totalLength - fixedFields. !
Item was changed: ----- Method: Interpreter>>stObject:at: (in category 'array primitive support') ----- stObject: array at: index "Return what ST would return for <obj> at: index."
| hdr fmt totalLength fixedFields stSize | <inline: false> hdr := objectMemory baseHeader: array. fmt := (hdr >> 8) bitAnd: 16rF. + totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt. - totalLength := self lengthOf: array baseHeader: hdr format: fmt. fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength. (fmt = 3 and: [self isContextHeader: hdr]) ifTrue: [stSize := self fetchStackPointerOf: array] ifFalse: [stSize := totalLength - fixedFields]. ((objectMemory oop: index isGreaterThanOrEqualTo: 1) and: [objectMemory oop: index isLessThanOrEqualTo: stSize]) ifTrue: [^ self subscript: array with: (index + fixedFields) format: fmt] ifFalse: [self primitiveFail. ^ 0].!
Item was changed: ----- Method: Interpreter>>stObject:at:put: (in category 'array primitive support') ----- stObject: array at: index put: value "Do what ST would return for <obj> at: index put: value." | hdr fmt totalLength fixedFields stSize | <inline: false> hdr := objectMemory baseHeader: array. fmt := (hdr >> 8) bitAnd: 16rF. + totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt. - totalLength := self lengthOf: array baseHeader: hdr format: fmt. fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength. (fmt = 3 and: [self isContextHeader: hdr]) ifTrue: [stSize := self fetchStackPointerOf: array] ifFalse: [stSize := totalLength - fixedFields]. ((objectMemory oop: index isGreaterThanOrEqualTo: 1) and: [objectMemory oop: index isLessThanOrEqualTo: stSize]) ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt] ifFalse: [self primitiveFail]!
Item was changed: ----- Method: Interpreter>>stSizeOf: (in category 'array primitive support') ----- stSizeOf: oop "Return the number of indexable fields in the given object. (i.e., what Smalltalk would return for <obj> size)." "Note: Assume oop is not a SmallInteger!!"
| hdr fmt totalLength fixedFields | <inline: false> hdr := objectMemory baseHeader: oop. fmt := (hdr >> 8) bitAnd: 16rF. + totalLength := objectMemory lengthOf: oop baseHeader: hdr format: fmt. - totalLength := self lengthOf: oop baseHeader: hdr format: fmt. fixedFields := objectMemory fixedFieldsOf: oop format: fmt length: totalLength. (fmt = 3 and: [self isContextHeader: hdr]) ifTrue: [^ self fetchStackPointerOf: oop] ifFalse: [^ totalLength - fixedFields]!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveInstVarAt (in category 'object access primitives') ----- primitiveInstVarAt | index rcvr hdr fmt totalLength fixedFields value | index := self stackIntegerValue: 0. rcvr := self stackValue: 1. self successful ifTrue: [hdr := objectMemory baseHeader: rcvr. fmt := hdr >> 8 bitAnd: 15. + totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt. - totalLength := self lengthOf: rcvr baseHeader: hdr format: fmt. fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength. (index >= 1 and: [index <= fixedFields]) ifFalse: [self primitiveFail]]. self successful ifTrue: [value := self subscript: rcvr with: index format: fmt]. self successful ifTrue: [self pop: argumentCount + 1 thenPush: value]!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveInstVarAtPut (in category 'object access primitives') ----- primitiveInstVarAtPut | newValue index rcvr hdr fmt totalLength fixedFields | newValue := self stackTop. index := self stackIntegerValue: 1. rcvr := self stackValue: 2. self successful ifTrue: [hdr := objectMemory baseHeader: rcvr. fmt := hdr >> 8 bitAnd: 15. + totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt. - totalLength := self lengthOf: rcvr baseHeader: hdr format: fmt. fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength. (index >= 1 and: [index <= fixedFields]) ifFalse: [self primitiveFail]]. self successful ifTrue: [self subscript: rcvr with: index storing: newValue format: fmt]. self successful ifTrue: [self pop: argumentCount + 1 thenPush: newValue]!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveStringReplace (in category 'indexing primitives') ----- primitiveStringReplace " <array> primReplaceFrom: start to: stop with: replacement startingAt: repStart <primitive: 105> " | array start stop repl replStart hdr arrayFmt totalLength arrayInstSize replFmt replInstSize srcIndex | array := self stackValue: 4. start := self stackIntegerValue: 3. stop := self stackIntegerValue: 2. repl := self stackValue: 1. replStart := self stackIntegerValue: 0.
self successful ifFalse: [^ self primitiveFail]. (objectMemory isIntegerObject: repl) ifTrue: ["can happen in LgInt copy" ^ self primitiveFail].
hdr := objectMemory baseHeader: array. arrayFmt := hdr >> 8 bitAnd: 15. + totalLength := objectMemory lengthOf: array baseHeader: hdr format: arrayFmt. - totalLength := self lengthOf: array baseHeader: hdr format: arrayFmt. arrayInstSize := objectMemory fixedFieldsOf: array format: arrayFmt length: totalLength. (start >= 1 and: [start - 1 <= stop and: [stop + arrayInstSize <= totalLength]]) ifFalse: [^ self primitiveFail].
hdr := objectMemory baseHeader: repl. replFmt := hdr >> 8 bitAnd: 15. + totalLength := objectMemory lengthOf: repl baseHeader: hdr format: replFmt. - totalLength := self lengthOf: repl baseHeader: hdr format: replFmt. replInstSize := objectMemory fixedFieldsOf: repl format: replFmt length: totalLength. (replStart >= 1 and: [stop - start + replStart + replInstSize <= totalLength]) ifFalse: [^ self primitiveFail].
"Array formats (without byteSize bits, if bytes array) must be same " arrayFmt < 8 ifTrue: [arrayFmt = replFmt ifFalse: [^ self primitiveFail]] ifFalse: [(arrayFmt bitAnd: 12) = (replFmt bitAnd: 12) ifFalse: [^ self primitiveFail]].
srcIndex := replStart + replInstSize - 1. "- 1 for 0-based access"
arrayFmt <= 4 ifTrue: ["pointer type objects" start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do: [:i | objectMemory storePointer: i ofObject: array withValue: (objectMemory fetchPointer: srcIndex ofObject: repl). srcIndex := srcIndex + 1]] ifFalse: [arrayFmt < 8 ifTrue: ["32-bit-word type objects" start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do: [:i | objectMemory storeLong32: i ofObject: array withValue: (objectMemory fetchLong32: srcIndex ofObject: repl). srcIndex := srcIndex + 1]] ifFalse: ["byte-type objects" start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do: [:i | objectMemory storeByte: i ofObject: array withValue: (objectMemory fetchByte: srcIndex ofObject: repl). srcIndex := srcIndex + 1]]]. "We might consider comparing stop - start to some value here and using forceInterruptCheck"
self pop: argumentCount "leave rcvr on stack"!
Item was changed: ----- Method: ObjectMemorySimulator>>firstIndexableField: (in category 'memory access') ----- firstIndexableField: oop "NOTE: overridden from Interpreter to add coercion to CArray"
| hdr fmt totalLength fixedFields | self returnTypeC: 'void *'. hdr := self baseHeader: oop. fmt := (hdr >> 8) bitAnd: 16rF. + totalLength := self lengthOf: oop baseHeader: hdr format: fmt. - totalLength := interpreter lengthOf: oop baseHeader: hdr format: fmt. fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength. fmt < 8 ifTrue: [fmt = 6 ifTrue: ["32 bit field objects" ^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + (fixedFields << 2)) to: 'int *']. "full word objects (pointer or bits)" ^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + (fixedFields << self shiftForWord)) to: 'oop *'] ifFalse: ["Byte objects" ^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + fixedFields) to: 'char *']!