[Vm-dev] VM Maker: VMMaker.oscog-eem.229.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Dec 11 22:07:02 UTC 2012
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.229.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.229
Author: eem
Time: 11 December 2012, 2:03:55.958 pm
UUID: d0568065-8deb-4e6e-8c98-798d0983ef52
Ancestors: VMMaker.oscog-eem.228
Streamline ObjectMemory>>instantiateClass:indexableSize: (hdrSize
and header3 change together).
Optimize the debug VM by making startOfMemory a macro that
answers heapBase instead of a method.
Improve stack page printing, and make stack trace printing more
robust (findClass/SelectorOfMethod:forReceiver:).
Make temporary:in:put: et al answer their values. For stObject:at:put:.
Remove dead code in TMethod (typedByPropagation).
make jumpTable size err message more explanatory.
typos.
=============== Diff against VMMaker.oscog-eem.228 ===============
Item was changed:
----- Method: CoInterpreter>>itemporary:in:put: (in category 'internal interpreter access') -----
itemporary: offset in: theFP put: valueOop
"Temporary access for an interpreter frame only."
"See StackInterpreter class>>initializeFrameIndices"
| frameNumArgs |
<inline: true>
<var: #theFP type: #'char *'>
+ ^offset < (frameNumArgs := self iframeNumArgs: theFP)
- offset < (frameNumArgs := self iframeNumArgs: theFP)
ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]
ifFalse: [stackPages longAt: theFP + FoxIFReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]!
Item was changed:
----- Method: CoInterpreter>>mtemporary:in:put: (in category 'internal interpreter access') -----
mtemporary: offset in: theFP put: valueOop
"Temporary access for a machine code frame only."
"See StackInterpreter class>>initializeFrameIndices"
| frameNumArgs |
<inline: true>
<var: #theFP type: #'char *'>
+ ^stackPages
- stackPages
longAt: (offset < (frameNumArgs := self mframeNumArgs: theFP)
ifTrue: [theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord)]
ifFalse: [theFP + FoxMFReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord)])
put: valueOop!
Item was changed:
----- Method: CoInterpreter>>temporary:in:put: (in category 'internal interpreter access') -----
temporary: offset in: theFP put: valueOop
<inline: true>
+ ^(self isMachineCodeFrame: theFP)
- (self isMachineCodeFrame: theFP)
ifTrue: [self mtemporary: offset in: theFP put: valueOop]
ifFalse: [self itemporary: offset in: theFP put: valueOop]!
Item was changed:
----- Method: CogObjectRepresentationForSqueakV3>>couldBeObject: (in category 'garbage collection') -----
couldBeObject: oop
^(objectMemory isNonIntegerObject: oop)
+ and: [oop asUnsignedInteger >= objectMemory nilObject]!
- and: [oop asUnsignedInteger > objectMemory startOfMemory]!
Item was changed:
----- Method: Cogit>>lookup:for:methodAndErrorSelectorInto: (in category 'in-line cacheing') -----
lookup: selector for: receiver methodAndErrorSelectorInto: binaryBlock
"Lookup selector in the class of receiver. If found, evaluate binaryBlock with the
method, cogged if appropriate.. If not found, due to MNU, lookup the DNU selector
and evaluate binaryBlock with the MNU method, cogged if appropriate.. If not found
due to cannot interpret, evaluate binaryBlock with a nil method and the error selector."
| methodOrSelectorIndex |
<inline: true>
methodOrSelectorIndex := coInterpreter
lookup: selector
receiver: receiver.
+ methodOrSelectorIndex asUnsignedInteger >= objectMemory nilObject ifTrue:
- methodOrSelectorIndex asUnsignedInteger > objectMemory startOfMemory ifTrue:
[(objectMemory isOopCompiledMethod: methodOrSelectorIndex) ifFalse:
[^binaryBlock value: methodOrSelectorIndex value: SelectorCannotInterpret].
((coInterpreter methodHasCogMethod: methodOrSelectorIndex) not
and: [coInterpreter methodShouldBeCogged: methodOrSelectorIndex]) ifTrue:
["We assume cog:selector: will *not* reclaim the method zone"
self cog: methodOrSelectorIndex selector: selector].
^binaryBlock value: methodOrSelectorIndex value: nil].
methodOrSelectorIndex = SelectorDoesNotUnderstand ifTrue:
[methodOrSelectorIndex := coInterpreter
lookup: (objectMemory splObj: SelectorDoesNotUnderstand)
receiver: receiver.
+ methodOrSelectorIndex asUnsignedInteger >= objectMemory nilObject ifTrue:
- methodOrSelectorIndex asUnsignedInteger > objectMemory startOfMemory ifTrue:
[self assert: (objectMemory isOopCompiledMethod: methodOrSelectorIndex).
((coInterpreter methodHasCogMethod: methodOrSelectorIndex) not
and: [coInterpreter methodShouldBeCogged: methodOrSelectorIndex]) ifTrue:
["We assume cog:selector: will *not* reclaim the method zone"
self cog: methodOrSelectorIndex selector: selector].
^binaryBlock value: methodOrSelectorIndex value: SelectorDoesNotUnderstand].
^binaryBlock value: nil value: SelectorDoesNotUnderstand].
^binaryBlock value: nil value: methodOrSelectorIndex!
Item was changed:
----- Method: Gnuifier>>gnuifyFrom:to: (in category 'as yet unclassified') -----
gnuifyFrom: inFileStream to: outFileStream
"convert interp.c to use GNU features"
| inData beforeInterpret inInterpret inInterpretVars beforePrimitiveResponse inPrimitiveResponse |
inData := inFileStream upToEnd withSqueakLineEndings.
inFileStream close.
"print a header"
outFileStream
nextPutAll: '/* This file has been post-processed for GNU C */';
cr; cr; cr.
beforeInterpret := true. "whether we are before the beginning of interpret()"
inInterpret := false. "whether we are in the middle of interpret"
inInterpretVars := false. "whether we are in the variables of interpret"
beforePrimitiveResponse := true. "whether we are before the beginning of primitiveResponse()"
inPrimitiveResponse := false. "whether we are inside of primitiveResponse"
'Gnuifying'
displayProgressAt: Sensor cursorPoint
from: 1 to: (inData occurrencesOf: Character cr)
during:
[:bar | | lineNumber |
lineNumber := 0.
inData linesDo:
[ :inLine | | outLine extraOutLine |
bar value: (lineNumber := lineNumber + 1).
outLine := inLine. "print out one line for each input line; by default, print out the line that was input, but some rules modify it"
extraOutLine := nil. "occasionally print a second output line..."
beforeInterpret ifTrue: [
(inLine = '#include "sq.h"') ifTrue: [
outLine := '#include "sqGnu.h"'. ].
(inLine beginsWith: 'interpret(void)') ifTrue: [
"reached the beginning of interpret"
beforeInterpret := false.
inInterpret := true.
inInterpretVars := true. ] ]
ifFalse: [
inInterpretVars ifTrue: [
(inLine findString: 'register struct foo * foo = &fum;') > 0 ifTrue: [
outLine := 'register struct foo * foo FOO_REG = &fum;' ].
(inLine findString: ' localIP;') > 0 ifTrue: [
outLine := ' register char* localIP IP_REG;' ].
(inLine findString: ' localFP;') > 0 ifTrue: [
outLine := ' register char* localFP FP_REG;' ].
(inLine findString: ' localSP;') > 0 ifTrue: [
outLine := ' register char* localSP SP_REG;' ].
(inLine findString: ' currentBytecode;') > 0 ifTrue: [
outLine := ' register sqInt currentBytecode CB_REG;' ].
inLine isEmpty ifTrue: [
"reached end of variables"
inInterpretVars := false.
outLine := ' JUMP_TABLE;'.
+ extraOutLine := '\#if MULTIPLEBYTECODESETS\ if(!!asserta((sizeof(jumpTable)/sizeof(jumpTable[0])) >= 512))\ error("bytecode jumpTable too small");\#endif\' withCRs]]
- extraOutLine := '\#if MULTIPLEBYTECODESETS\ if(!!asserta((sizeof(jumpTable)/sizeof(jumpTable[0])) >= 512))\ error("jumpTable too small");\#endif\' withCRs]]
ifFalse: [
inInterpret ifTrue: [
"working inside interpret(); translate the switch statement"
(inLine beginsWith: ' case ') ifTrue: [
| tokens |
tokens := inLine findTokens: ' :'.
outLine := ' CASE(', tokens second, ')'.
tokens size > 2 ifTrue:
[(tokens allButFirst: 2) do:
[:token| outLine := outLine, ' ', token]]].
inLine = ' break;' ifTrue: [
outLine := ' BREAK;' ].
inLine = '}' ifTrue: [
"all finished with interpret()"
inInterpret := false. ] ]
ifFalse: [
beforePrimitiveResponse ifTrue: [
(inLine beginsWith: 'primitiveResponse(') ifTrue: [
"into primitiveResponse we go"
beforePrimitiveResponse := false.
inPrimitiveResponse := true.
extraOutLine := ' PRIM_TABLE;'. ] ]
ifFalse: [
inPrimitiveResponse ifTrue: [
(inLine = ' switch (primitiveIndex) {') ifTrue: [
extraOutLine := outLine.
outLine := ' PRIM_DISPATCH;' ].
(inLine = ' switch (GIV(primitiveIndex)) {') ifTrue: [
extraOutLine := outLine.
outLine := ' PRIM_DISPATCH;' ].
(inLine beginsWith: ' case ') ifTrue: [
| caseLabel |
caseLabel := (inLine findTokens: ' :') second.
outLine := ' CASE(', caseLabel, ')' ].
inLine = '}' ifTrue: [
inPrimitiveResponse := false ] ].
] ] ] ].
outFileStream nextPutAll: outLine; cr.
extraOutLine ifNotNil: [
outFileStream nextPutAll: extraOutLine; cr ]]].
outFileStream close!
Item was changed:
----- Method: NewCoObjectMemory>>startOfMemory (in category 'accessing') -----
startOfMemory
"Return the start of object memory. This is immediately after the native code zone.
+ N.B. the stack zone is alloca'ed. Use a macro so as not to punish the debug VM."
+ <cmacro: '() heapBase'>
- N.B. the stack zone is alloca'ed."
- <api>
<returnTypeC: #usqInt>
^coInterpreter heapBase!
Item was changed:
----- Method: ObjectMemory>>instantiateClass:indexableSize: (in category 'interpreter access') -----
instantiateClass: classPointer indexableSize: size
"NOTE: This method supports the backward-compatible split instSize field of the
class format word. The sizeHiBits will go away and other shifts change by 2
when the split fields get merged in an (incompatible) image change."
<api>
+ | hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat |
- | hash header1 header2 cClass byteSize format binc header3 hdrSize newObj sizeHiBits bm1 classFormat |
<inline: false>
self assert: size >= 0. "'cannot have a negative indexable field count"
hash := self newObjectHash.
classFormat := self formatOfClass: classPointer.
"Low 2 bits are 0"
header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
header2 := classPointer.
- header3 := 0.
sizeHiBits := (classFormat bitAnd: 16r60000) >> 9.
cClass := header1 bitAnd: CompactClassMask. "compact class field from format word"
byteSize := (classFormat bitAnd: SizeMask + Size4Bit) + sizeHiBits.
"size in bytes -- low 2 bits are 0"
"Note this byteSize comes from the format word of the class which is pre-shifted
to 4 bytes per field. Need another shift for 8 bytes per word..."
byteSize := byteSize << (ShiftForWord-2).
format := self formatOfHeader: classFormat.
self flag: #sizeLowBits.
format < 8
ifTrue:
[format = 6
ifTrue: ["long32 bitmaps"
bm1 := BytesPerWord-1.
byteSize := byteSize + (size * 4) + bm1 bitAnd: LongSizeMask. "round up"
binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes"
"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: (binc bitAnd: 4)]
ifFalse: [byteSize := byteSize + (size * BytesPerWord) "Arrays and 64-bit bitmaps"]]
ifFalse:
["Strings and Methods"
bm1 := BytesPerWord-1.
byteSize := byteSize + size + bm1 bitAnd: LongSizeMask. "round up"
binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes"
"low bits of byte size go in format field"
header1 := header1 bitOr: (binc bitAnd: 3) << 8.
"extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: (binc bitAnd: 4)].
+ byteSize > 255 "requires size header word/full header"
+ ifTrue: [header3 := byteSize. hdrSize := 3]
+ ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := cClass = 0 ifTrue: [2] ifFalse: [1]].
+ ^self allocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format!
- byteSize > 255
- ifTrue: ["requires size header word"
- header3 := byteSize.
- header1 := header1]
- ifFalse: [header1 := header1 bitOr: byteSize].
-
- hdrSize := header3 > 0
- ifTrue: [3 "requires full header"]
- ifFalse: [cClass = 0 ifTrue: [2] ifFalse: [1]].
- newObj := self allocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format.
- ^ newObj!
Item was changed:
----- Method: ObjectMemory>>startOfMemory (in category 'object enumeration') -----
startOfMemory
+ "Return the start of object memory. Use a macro so as not to punish the debug VM."
+ <cmacro: '() memory'>
- "Return the start of object memory."
<returnTypeC: #usqInt>
^memory!
Item was changed:
----- Method: StackInterpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
findClassOfMethod: meth forReceiver: rcvr
+ | rclass currClass classDict classDictSize methodArray i |
+ (self addressCouldBeObj: meth) ifFalse:
+ [^objectMemory nilObject].
+ (self addressCouldBeOop: rcvr)
+ ifTrue: [rclass := objectMemory fetchClassOf: rcvr]
+ ifFalse: [rclass := self methodClassOf: meth].
+ currClass := rclass.
- | currClass classDict classDictSize methodArray i |
- currClass := objectMemory fetchClassOf: rcvr.
[classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass.
classDictSize := objectMemory fetchWordLengthOf: classDict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue:
[meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
[^currClass].
i := i + 1].
currClass := self superclassOf: currClass.
currClass = objectMemory nilObject] whileFalse.
+ ^rclass "method not found in superclass chain"!
- ^objectMemory fetchClassOf: rcvr "method not found in superclass chain"!
Item was changed:
----- Method: StackInterpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') -----
findSelectorOfMethod: meth forReceiver: rcvr
| currClass classDict classDictSize methodArray i |
+ (self addressCouldBeObj: meth) ifFalse:
+ [^objectMemory nilObject].
+ (self addressCouldBeOop: rcvr)
+ ifTrue: [currClass := objectMemory fetchClassOf: rcvr]
+ ifFalse: [currClass := self methodClassOf: meth].
- currClass := objectMemory fetchClassOf: rcvr.
[classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass.
classDictSize := objectMemory fetchWordLengthOf: classDict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i <= (classDictSize - SelectorStart)] whileTrue:
[meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
[^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)].
i := i + 1].
currClass := self superclassOf: currClass.
currClass = objectMemory nilObject] whileFalse.
^currClass "method not found in superclass chain"!
Item was changed:
----- Method: StackInterpreter>>noInlineTemporary:in:put: (in category 'internal interpreter access') -----
noInlineTemporary: offset in: theFP put: valueOop
<var: #theFP type: #'char *'>
<inline: false>
+ ^self temporary: offset in: theFP put: valueOop!
- self temporary: offset in: theFP put: valueOop!
Item was changed:
----- Method: StackInterpreter>>printStackPage: (in category 'debug printing') -----
printStackPage: page
<inline: false>
<var: #page type: #'StackPage *'>
self print: 'page '; printHexPtr: (self cCode: [page] inSmalltalk: [page baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page realStackLimit);
print: ') (trace: '; printNum: page trace; printChar: $).
(stackPages isFree: page) ifTrue:
[self print: ' (free)'].
page = stackPages mostRecentlyUsedPage ifTrue:
[self print: ' (MRU)'].
+ self cr; tab; print: 'ba: ';
+ printHexPtr: page baseAddress; print: ' - sl: ';
+ printHexPtr: page realStackLimit; print: ' - sl-so: ';
+ printHexPtr: page realStackLimit - self stackLimitOffset; print: ' - la:';
- self cr; tab;
- printHexPtr: page baseAddress; print: ' - ';
- printHexPtr: page realStackLimit; print: ' - ';
printHexPtr: page lastAddress.
(stackPages isFree: page) ifFalse:
[self cr; tab; print: 'baseFP '; printHexPtr: page baseFP.
self "cr;" tab; print: 'headFP '; printHexPtr: page headFP.
self "cr;" tab; print: 'headSP '; printHexPtr: page headSP].
self cr; tab; print: 'prev '; printHexPtr: (self cCode: 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page prevPage realStackLimit); printChar: $).
self tab; print: 'next '; printHexPtr: (self cCode: 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page nextPage realStackLimit); printChar: $).
self cr!
Item was changed:
----- Method: StackInterpreter>>temporary:in:put: (in category 'internal interpreter access') -----
temporary: offset in: theFP put: valueOop
"See StackInterpreter class>>initializeFrameIndices"
| frameNumArgs |
<inline: true>
<var: #theFP type: #'char *'>
+ ^offset < (frameNumArgs := self frameNumArgs: theFP)
- offset < (frameNumArgs := self frameNumArgs: theFP)
ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]
ifFalse: [stackPages longAt: theFP + FoxReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]!
Item was changed:
Object subclass: #TMethod
+ instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels writtenToGlobalVarsCache complete export static sharedLabel sharedCase comment definingClass globalStructureBuildMethodHasFoo canAsmLabel mustAsmLabel properties cascadeVariableNumber'
- instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels writtenToGlobalVarsCache complete export static sharedLabel sharedCase comment definingClass globalStructureBuildMethodHasFoo canAsmLabel mustAsmLabel properties typedByPropagation cascadeVariableNumber'
classVariableNames: 'CaseStatements'
poolDictionaries: ''
category: 'VMMaker-Translation to C'!
Item was removed:
- ----- Method: TMethod>>noteTypedByPropagation: (in category 'inlining') -----
- noteTypedByPropagation: aVariableName
- typedByPropagation ifNil:
- [typedByPropagation := Set new].
- typedByPropagation add: aVariableName!
Item was changed:
----- Method: TMethod>>postCopy (in category 'copying') -----
postCopy
args := args copy.
locals := locals copy.
declarations := declarations copy.
parseTree := parseTree copy.
+ labels := labels copy!
- labels := labels copy.
- typedByPropagation := typedByPropagation copy!
Item was removed:
- ----- Method: TMethod>>wasTypedByPropagation: (in category 'inlining') -----
- wasTypedByPropagation: aVariableName
- ^typedByPropagation notNil
- and: [typedByPropagation includes: aVariableName]!
Item was changed:
----- Method: VMClass class>>translationClass (in category 'translation') -----
translationClass
+ "Return the class to use as the interpreterCLass when translating. For the all-in-one
- "Return te class to use as the interpreterCLass when translating. For the all-in-one
VMs that inherit from ObjectMemory this is the receiver. But for the separate VMs
where most primitives are in a subclass it will be the subclass with the primitives."
^self!
More information about the Vm-dev
mailing list