[Vm-dev] VM Maker: VMMaker-dtl.386.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Sep 11 22:45:47 UTC 2016
David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.386.mcz
==================== Summary ====================
Name: VMMaker-dtl.386
Author: dtl
Time: 11 September 2016, 6:36:12.597 pm
UUID: 2f6df284-6ad4-41d3-a07b-040737720714
Ancestors: VMMaker-dtl.385
VMMaker 4.15.8
Update primitiveAdoptInstance and related methods from latest oscog. Resolves a problem in which primitive could fail but still modify the stack.
Add SlangTest>>testStatementListAsExpression to document a missing feature from oscog code generator not yet present here. Reorganize objCouldBeClassObj: to avoid the feature.
=============== Diff against VMMaker-dtl.385 ===============
Item was removed:
- ----- Method: ContextInterpreter>>changeClassOf:to: (in category 'object access primitives') -----
- changeClassOf: rcvr to: argClass
- "Change the class of the receiver into the class specified by the argument given that the format of the receiver matches the format of the argument. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have."
- | classHdr sizeHiBits byteSize argFormat rcvrFormat ccIndex |
- "Check what the format of the class says"
- classHdr := objectMemory formatOfClass: argClass. "Low 2 bits are 0"
-
- "Compute the size of instances of the class (used for fixed field classes only)"
- sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
- classHdr := classHdr bitAnd: 16r1FFFF.
- byteSize := (classHdr bitAnd: objectMemory sizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
-
- "Check the receiver's format against that of the class"
- argFormat := (classHdr >> 8) bitAnd: 16rF.
- rcvrFormat := objectMemory formatOf: rcvr.
- argFormat = rcvrFormat ifFalse:[^self primitiveFail]. "no way"
-
- "For fixed field classes, the sizes must match.
- Note: byteSize-4 because base header is included in class size."
- argFormat < 2 ifTrue:[(byteSize - 4) = (objectMemory byteSizeOf: rcvr) ifFalse:[^self primitiveFail]].
-
- (objectMemory headerType: rcvr) = HeaderTypeShort
- ifTrue:[ "Compact classes. Check if the arg's class is compact and exchange ccIndex"
- ccIndex := classHdr bitAnd: CompactClassMask.
- ccIndex = 0 ifTrue:[^self primitiveFail]. "class is not compact"
- objectMemory longAt: rcvr put:
- (((objectMemory longAt: rcvr) bitAnd: CompactClassMask bitInvert32)
- bitOr: ccIndex)]
- ifFalse:["Exchange the class pointer, which could make rcvr a root for argClass"
- objectMemory longAt: rcvr - objectMemory baseHeaderSize put: (argClass bitOr: (objectMemory headerType: rcvr)).
- (objectMemory oop: rcvr isLessThan: objectMemory getYoungStart)
- ifTrue: [objectMemory possibleRootStoreInto: rcvr value: argClass]]!
Item was removed:
- ----- Method: ContextInterpreter>>primitiveChangeClassWithClass (in category 'object access primitives') -----
- primitiveChangeClassWithClass
- "Primitive. Change the class of the receiver into the class of the argument given that the format of the receiver matches the format of the argument's class. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have."
- | rcvr argClass |
- <export: true>
- self methodArgumentCount = 1 ifFalse: [self primitiveFail. ^ nil].
-
- argClass := self stackObjectValue: 0.
- rcvr := self stackObjectValue: 1.
-
- self changeClassOf: rcvr to: argClass.
- self successful ifTrue: [ self flushAtCache. self pop: 1 ].
- ^ nil.
- !
Item was added:
+ ----- Method: Interpreter>>objCouldBeClassObj: (in category 'debug support') -----
+ objCouldBeClassObj: objOop
+ "Answer if objOop looks like a class object. WIth Spur be lenient if the object doesn't
+ yet have a hash (i.e. is not yet in the classTable), and accept forwarding pointers."
+ <api>
+ | fieldOop |
+ self flag: #FIXME. "dtl - Reorganized to work around limitation in code generator, need oscog updates for code gen. Original oscog implementation is in class StackInterpreter."
+ [objectMemory isPointersNonImm: objOop] ifTrue: [^ false].
+ (objectMemory numSlotsOf: objOop) > InstanceSpecificationIndex
+ ifTrue: [fieldOop := objectMemory fetchPointer: SuperclassIndex ofObject: objOop.
+ ((objectMemory addressCouldBeObj: fieldOop)
+ and: [(objectMemory isPointersNonImm: fieldOop)
+ or: [(objectMemory isOopForwarded: fieldOop)
+ and: [objectMemory
+ isPointers: (objectMemory followForwarded: fieldOop)]]])
+ ifTrue: [fieldOop := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop.
+ ^ (((objectMemory addressCouldBeObj: fieldOop)
+ and: [(objectMemory isPointersNonImm: fieldOop)
+ or: [(objectMemory isOopForwarded: fieldOop)
+ and: [objectMemory
+ isPointers: (objectMemory followForwarded: fieldOop)]]])
+ and: [objectMemory
+ isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: objOop)])]].
+ ^ false!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveAdoptInstance (in category 'object access primitives') -----
primitiveAdoptInstance
"Primitive. Change the class of the argument to make it an instance of the receiver
given that the format of the receiver matches the format of the argument's class.
Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a
compact class and the argument isn't, or when the argument's class is compact and
the receiver isn't, or when the format of the receiver is different from the format of
the argument's class, or when the arguments class is fixed and the receiver's size
differs from the size that an instance of the argument's class should have."
| rcvr arg err |
+ arg := self stackTop.
+ rcvr := self stackValue: 1.
+ ((objectMemory isImmediate: arg)
+ or: [argumentCount > 1
+ and: [(objectMemory isImmediate: rcvr)
+ or: [(self objCouldBeClassObj: rcvr) not]]]) ifTrue:
+ [^self primitiveFailFor: PrimErrBadArgument].
- arg := self stackObjectValue: 0.
- rcvr := self stackObjectValue: 1.
+ err := objectMemory changeClassOf: arg to: rcvr.
- err := self changeClassOf: arg to: rcvr.
err = 0
ifTrue: ["Flush at cache because rcvr's class has changed."
self flushAtCache.
self pop: self methodArgumentCount]
+ ifFalse: [self primitiveFailFor: err].
- ifFalse: [self primitiveFail].
^nil!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveChangeClass (in category 'object access primitives') -----
primitiveChangeClass
+ "Primitive. Change the class of the receiver into the class of the argument given that
+ the format of the receiver matches the format of the argument's class. Fail if the
+ receiver or argument are SmallIntegers, or the receiver is an instance of a compact
+ class and the argument isn't, or when the argument's class is compact and the receiver
+ isn't, or when the format of the receiver is different from the format of the argument's
+ class, or when the arguments class is fixed and the receiver's size differs from the size
+ that an instance of the argument's class should have."
+ | arg rcvr argClass err |
- "Primitive. Change the class of the receiver into the class of the argument given that the format of the receiver matches the format of the argument's class. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have."
- | arg rcvr argClass |
-
- self methodArgumentCount = 1 ifFalse: [self primitiveFail. ^ nil].
-
arg := self stackObjectValue: 0.
rcvr := self stackObjectValue: 1.
+ self successful ifFalse:[^nil].
+ argClass := objectMemory fetchClassOfNonImm: arg.
+ err := objectMemory changeClassOf: rcvr to: argClass.
+ err = 0
+ ifTrue: ["Flush at cache because rcvr's class has changed."
+ self flushAtCache.
+ self pop: self methodArgumentCount]
+ ifFalse: [self primitiveFailFor: err].
+ ^nil!
- argClass := objectMemory fetchClassOf: arg.
- self changeClassOf: rcvr to: argClass.
- self successful ifTrue: [ self flushAtCache. self pop: 1 ].
- ^ nil.
- !
Item was added:
+ ----- Method: ObjectMemory>>arrayFormat (in category 'header formats') -----
+ arrayFormat
+ <api>
+ ^2!
Item was added:
+ ----- Method: ObjectMemory>>baseHeader:put: (in category 'header access') -----
+ baseHeader: oop put: aWord
+
+ ^ self longAt: oop put: aWord!
Item was added:
+ ----- Method: ObjectMemory>>changeClassOf:to: (in category 'interpreter access') -----
+ changeClassOf: rcvr to: argClass
+ "Attempt to change the class of the receiver to the argument given that the
+ format of the receiver matches the format of the argument. If successful,
+ answer 0, otherwise answer an error code indicating the reason for failure.
+ Fail if the receiver is an instance of a compact class and the argument isn't,
+ or if the format of the receiver is incompatible with the format of the argument,
+ or if the argument is a fixed class and the receiver's size differs from the size
+ that an instance of the argument should have."
+ | classHdr sizeHiBits argClassInstByteSize argFormat rcvrFormat rcvrHdr ccIndex |
+ "Check what the format of the class says"
+ classHdr := self formatOfClass: argClass. "Low 2 bits are 0"
+
+ "Compute the size of instances of the class (used for fixed field classes only)"
+ sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
+ classHdr := classHdr bitAnd: 16r1FFFF.
+ argClassInstByteSize := (classHdr bitAnd: self sizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
+
+ "Check the receiver's format against that of the class"
+ argFormat := self formatOfHeader: classHdr.
+ rcvrHdr := self baseHeader: rcvr.
+ rcvrFormat := self formatOfHeader: rcvrHdr.
+ "If the receiver is a byte object we need to clear the number of odd bytes from the format."
+ rcvrFormat > self firstByteFormat ifTrue:
+ [rcvrFormat := rcvrFormat bitAnd: 16rC].
+ argFormat = rcvrFormat ifFalse:
+ [^PrimErrInappropriate]. "no way"
+
+ "For fixed field classes, the sizes must match.
+ Note: argClassInstByteSize-4 because base header is included in class size."
+ argFormat < self arrayFormat
+ ifTrue:
+ [(argClassInstByteSize - self baseHeaderSize) ~= (self numBytesOf: rcvr) ifTrue:
+ [^PrimErrBadReceiver]]
+ ifFalse:
+ [argFormat = self indexablePointersFormat ifTrue: "For indexable plus fixed fields the receiver must be at least big enough."
+ [(argClassInstByteSize - self baseHeaderSize) > (self numBytesOf: rcvr) ifTrue:
+ [^PrimErrBadReceiver]]].
+
+ (self headerTypeOfHeader: rcvrHdr) = HeaderTypeShort
+ ifTrue: "Compact classes. Check if the arg's class is compact and exchange ccIndex"
+ [ccIndex := classHdr bitAnd: CompactClassMask.
+ ccIndex = 0 ifTrue:
+ [^PrimErrInappropriate]. "class is not compact"
+ "self cppIf: IMMUTABILITY
+ ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
+ [^PrimErrNoModification]]."
+ self baseHeader: rcvr put: ((rcvrHdr bitClear: CompactClassMask) bitOr: ccIndex)]
+ ifFalse: "Exchange the class pointer, which could make rcvr a root for argClass"
+ ["self cppIf: IMMUTABILITY
+ ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
+ [^PrimErrNoModification]]."
+ "N.B. the recursive scan-mark algorithm uses the header word's size and compact class
+ fields to determine the header type when it reuses the header type bits for the mark
+ state. So it is alas an invariant that non-compact headers have a 0 compact class field."
+ (self compactClassIndexOfHeader: rcvrHdr) ~= 0 ifTrue:
+ [self baseHeader: rcvr put: (rcvrHdr bitClear: CompactClassMask)].
+ self longAt: rcvr - self baseHeaderSize put: (argClass bitOr: (self headerTypeOfHeader: rcvrHdr)).
+ (self oop: rcvr isLessThan: youngStart) ifTrue:
+ [self possibleRootStoreInto: rcvr value: argClass]].
+ "ok"
+ ^0!
Item was added:
+ ----- Method: ObjectMemory>>compactClassAt: (in category 'interpreter access') -----
+ compactClassAt: ccIndex
+ "Index must be between 1 and compactClassArray size. A zero compact class
+ index in the base header indicates that the class is in the class header word."
+ <api>
+ <inline: true>
+ ^self fetchPointer: ccIndex - 1 ofObject: (self splObj: CompactClasses)!
Item was added:
+ ----- Method: ObjectMemory>>fetchClassOfNonImm: (in category 'object access') -----
+ fetchClassOfNonImm: oop
+ | ccIndex |
+ <inline: true>
+ ^(ccIndex := (self compactClassIndexOf: oop)) = 0
+ ifTrue: [(self classHeader: oop) bitAnd: self allButTypeMask]
+ ifFalse: [self compactClassAt: ccIndex]!
Item was added:
+ ----- Method: ObjectMemory>>firstByteFormat (in category 'header formats') -----
+ firstByteFormat
+ <api>
+ <cmacro>
+ ^8!
Item was changed:
----- Method: ObjectMemory>>firstCompiledMethodFormat (in category 'header formats') -----
firstCompiledMethodFormat
<api>
+ <cmacro>
^12!
Item was added:
+ ----- Method: ObjectMemory>>firstLongFormat (in category 'header formats') -----
+ firstLongFormat
+ <api>
+ <cmacro>
+ ^6!
Item was added:
+ ----- Method: ObjectMemory>>firstStringyFakeFormat (in category 'header formats') -----
+ firstStringyFakeFormat
+ "A fake format for the interpreter used to mark indexable strings in
+ the interpreter's at cache. This is larger than any format."
+ ^16!
Item was added:
+ ----- Method: ObjectMemory>>followForwarded: (in category 'spur compatibility') -----
+ followForwarded: objOop
+ <inline: false>
+ "self shouldNotImplement."
+ ^0!
Item was added:
+ ----- Method: ObjectMemory>>headerTypeOfHeader: (in category 'header access') -----
+ headerTypeOfHeader: header
+
+ ^header bitAnd: TypeMask!
Item was changed:
----- Method: ObjectMemory>>indexablePointersFormat (in category 'header formats') -----
indexablePointersFormat
<api>
+ <cmacro>
^3!
Item was added:
+ ----- Method: ObjectMemory>>isImmediate: (in category 'interpreter access') -----
+ isImmediate: anOop
+ <api>
+ ^self isIntegerObject: anOop!
Item was added:
+ ----- Method: ObjectMemory>>isOopForwarded: (in category 'interpreter access') -----
+ isOopForwarded: oop
+ "Compatibility wth SpurMemoryManager. In ObjectMemory, no forwarding pointers
+ are visible to the VM."
+ <inline: true>
+ ^false!
Item was added:
+ ----- Method: ObjectMemory>>isPointersNonImm: (in category 'header access') -----
+ isPointersNonImm: oop
+ "Answer if the argument has only fields that can hold oops. See comment in formatOf:"
+
+ ^(self formatOf: oop) <= self lastPointerFormat!
Item was added:
+ ----- Method: ObjectMemory>>numBytesOf: (in category 'object access') -----
+ numBytesOf: objOop
+ "Answer the number of indexable bytes in the given non-immediate object.
+ Does not adjust the size of contexts by stackPointer."
+ <api>
+ | header sz fmt |
+ header := self baseHeader: objOop.
+ sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
+ ifTrue: [(self sizeHeader: objOop) bitAnd: self allButTypeMask]
+ ifFalse: [header bitAnd: self sizeMask].
+ fmt := self formatOfHeader: header.
+ ^fmt < self firstByteFormat
+ ifTrue: [(sz - self baseHeaderSize)] "words"
+ ifFalse: [(sz - self baseHeaderSize) - (fmt bitAnd: 3)] "bytes"!
Item was added:
+ ----- Method: ObjectMemory>>numSlotsOf: (in category 'object access') -----
+ numSlotsOf: obj
+ "Answer the number of oop-sized elements in the given object.
+ Unlike lengthOf: this does not adjust the length of a context
+ by the stackPointer and so can be used e.g. by cloneContext:"
+ <api>
+ | header sz |
+ header := self baseHeader: obj.
+ sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
+ ifTrue: [(self sizeHeader: obj) bitAnd: self allButTypeMask]
+ ifFalse: [header bitAnd: self sizeMask].
+ ^sz - self baseHeaderSize >> self shiftForWord!
Item was added:
+ ----- Method: ObjectMemory>>sixtyFourBitIndexableFormat (in category 'header formats') -----
+ sixtyFourBitIndexableFormat
+ ^7!
Item was added:
+ ----- Method: ObjectMemory>>weakArrayFormat (in category 'header formats') -----
+ weakArrayFormat
+ <api>
+ <cmacro>
+ ^4!
Item was added:
+ ----- Method: SlangTest>>testStatementListAsExpression (in category 'testing interpreter') -----
+ testStatementListAsExpression
+ "When a list of statements is used in a target block of an ifTrue:ifFalse: or
+ similar, use comma as the statement separator in the generated C.
+ Motivated by #objCouldBeClassObj: implementation in oscog."
+
+ "(SlangTest selector: #testStatementListAsExpression) debug"
+
+ | stssi s |
+ stssi := SlangTestSupportInterpreter inline: true.
+ self halt.
+ s := stssi asCString: #statementListAsExpression.
+
+ self deny: ['*BAR;*BAZ*' match: s]. "terminator character following BAR should not be a semicolon"
+ self assert: ['*BAR,*BAZ*' match: s]. "instead,use comma to separate statements within expression"
+ !
Item was added:
+ ----- Method: SlangTestSupportInterpreter>>statementListAsExpression (in category 'blocks and conditionals') -----
+ statementListAsExpression
+ "The #BAR and #BAZ statement list should generate statements separated by
+ comma rather than terminated by semicolon."
+ ^#FOO
+ and: [
+ #BAR.
+ #BAZ
+ ]!
Item was changed:
----- Method: VMMaker class>>versionString (in category 'version testing') -----
versionString
"VMMaker versionString"
+ ^'4.15.8'!
- ^'4.15.7'!
More information about the Vm-dev
mailing list