Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.400.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.400 Author: eem Time: 21 September 2013, 7:46:26.362 am UUID: 3481cf9c-80d0-47db-b5c4-07102f7ea255 Ancestors: VMMaker.oscog-eem.399
Make the Inflate/DeflatePlugin simulate.
Simplify loadColorMapShiftOrMaskFrom: & others; isWords:, isBytes: et al check for immediates already.
Add printHexnp: for unpadded hex printing & use in longPrintOop:.
Add a print stack call stack to print less stack :)
=============== Diff against VMMaker.oscog-eem.399 ===============
Item was changed: ----- Method: BitBltSimulation>>loadColorMapShiftOrMaskFrom: (in category 'interpreter interface') ----- loadColorMapShiftOrMaskFrom: mapOop <returnTypeC:'void *'> mapOop = interpreterProxy nilObject ifTrue:[^nil]. - (interpreterProxy isIntegerObject: mapOop) - ifTrue:[interpreterProxy primitiveFail. ^nil]. ((interpreterProxy isWords: mapOop) and:[(interpreterProxy slotSizeOf: mapOop) = 4]) ifFalse:[interpreterProxy primitiveFail. ^nil]. ^interpreterProxy firstIndexableField: mapOop!
Item was added: + ----- Method: InflatePlugin class>>simulatorClass (in category 'simulation') ----- + simulatorClass + "For running from Smalltalk - answer a class that can be used to simulate the receiver, + or nil if you want the primitives in this module to always fail, causing simulation to fall + through to the Smalltalk code. By default every non-TestInterpreterPlugin can simulate itself." + + ^DeflatePlugin!
Item was changed: ----- Method: InflatePlugin>>primitiveInflateDecompressBlock (in category 'primitives') ----- primitiveInflateDecompressBlock "Primitive. Inflate a single block." | oop rcvr | <export: true> + interpreterProxy methodArgumentCount = 2 ifFalse: + [^interpreterProxy primitiveFail]. - interpreterProxy methodArgumentCount = 2 ifFalse:[^interpreterProxy primitiveFail]. "distance table" + oop := interpreterProxy stackValue: 0. + (interpreterProxy isWords: oop) ifFalse: + [^interpreterProxy primitiveFail]. - oop := interpreterProxy stackObjectValue: 0. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isWords: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipDistTable := interpreterProxy firstIndexableField: oop. zipDistTableSize := interpreterProxy slotSizeOf: oop.
"literal table" + oop := interpreterProxy stackValue: 1. + (interpreterProxy isWords: oop) ifFalse: + [^interpreterProxy primitiveFail]. - oop := interpreterProxy stackObjectValue: 1. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isWords: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipLitTable := interpreterProxy firstIndexableField: oop. zipLitTableSize := interpreterProxy slotSizeOf: oop.
"Receiver (InflateStream)" + rcvr := interpreterProxy stackValue: 2. + (interpreterProxy isPointers: rcvr) ifFalse: + [^interpreterProxy primitiveFail]. - rcvr := interpreterProxy stackObjectValue: 2. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isPointers: rcvr) - ifFalse:[^interpreterProxy primitiveFail]. (interpreterProxy slotSizeOf: rcvr) < 9 ifTrue:[^interpreterProxy primitiveFail].
"All the integer instvars" zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr. zipState := interpreterProxy fetchInteger: 3 ofObject: rcvr. zipBitBuf := interpreterProxy fetchInteger: 4 ofObject: rcvr. zipBitPos := interpreterProxy fetchInteger: 5 ofObject: rcvr. zipSourcePos := interpreterProxy fetchInteger: 7 ofObject: rcvr. zipSourceLimit := interpreterProxy fetchInteger: 8 ofObject: rcvr. interpreterProxy failed ifTrue:[^nil]. zipReadLimit := zipReadLimit - 1. zipSourcePos := zipSourcePos - 1. zipSourceLimit := zipSourceLimit - 1.
"collection" oop := interpreterProxy fetchPointer: 0 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isIntegerObject: oop) - ifTrue:[^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipCollection := interpreterProxy firstIndexableField: oop. zipCollectionSize := interpreterProxy byteSizeOf: oop.
"source" oop := interpreterProxy fetchPointer: 6 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isIntegerObject: oop) - ifTrue:[^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipSource := interpreterProxy firstIndexableField: oop.
"do the primitive" self zipDecompressBlock. + interpreterProxy failed ifFalse: "store modified values back" + [interpreterProxy storeInteger: 2 ofObject: rcvr withValue: zipReadLimit + 1. - interpreterProxy failed ifFalse:[ - "store modified values back" - interpreterProxy storeInteger: 2 ofObject: rcvr withValue: zipReadLimit + 1. interpreterProxy storeInteger: 3 ofObject: rcvr withValue: zipState. interpreterProxy storeInteger: 4 ofObject: rcvr withValue: zipBitBuf. interpreterProxy storeInteger: 5 ofObject: rcvr withValue: zipBitPos. interpreterProxy storeInteger: 7 ofObject: rcvr withValue: zipSourcePos + 1. + interpreterProxy pop: 2]! - interpreterProxy pop: 2. - ].!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveIntegerAt (in category 'sound primitives') ----- primitiveIntegerAt "Return the 32bit signed integer contents of a words receiver"
| index rcvr sz addr value intValue | <var: #intValue type: 'int'> index := self stackIntegerValue: 0. self successful ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackValue: 1. + (objectMemory isWords: rcvr) ifFalse: - ((objectMemory isIntegerObject: rcvr) - or: [(objectMemory isWords: rcvr) not]) ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. sz := objectMemory lengthOf: rcvr. "number of fields" ((index >= 1) and: [index <= sz]) ifFalse: [^self primitiveFailFor: PrimErrBadIndex]. + "4 = 32 bits / 8" + addr := rcvr + objectMemory baseHeaderSize + (index - 1 * 4). "for zero indexing" + value := objectMemory intAt: addr. - addr := rcvr + BaseHeaderSize + (index - 1 * BytesPerWord). "for zero indexing" - value := self intAt: addr. self pop: 2. "pop rcvr, index" "push element value" (objectMemory isIntegerValue: value) ifTrue: [self pushInteger: value] ifFalse: [intValue := value. "32 bit int may have been stored in 32 or 64 bit sqInt" self push: (self signed32BitIntegerFor: intValue)] "intValue may be sign extended to 64 bit sqInt"!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveIntegerAtPut (in category 'sound primitives') ----- primitiveIntegerAtPut "Return the 32bit signed integer contents of a words receiver" | index rcvr sz addr value valueOop | <var: 'value' type: 'int'> valueOop := self stackValue: 0. index := self stackIntegerValue: 1. value := self signed32BitValueOf: valueOop. self successful ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackValue: 2. + (objectMemory isWords: rcvr) ifFalse: - ((objectMemory isIntegerObject: rcvr) - or: [(objectMemory isWords: rcvr) not]) ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. sz := objectMemory lengthOf: rcvr. "number of fields" (index >= 1 and: [index <= sz]) ifFalse: [^self primitiveFailFor: PrimErrBadIndex]. + "4 = 32 bits / 8" + addr := rcvr + objectMemory baseHeaderSize + (index - 1 * 4). "for zero indexing" + value := objectMemory intAt: addr put: value. - addr := rcvr + BaseHeaderSize + (index - 1 * BytesPerWord). "for zero indexing" - value := self intAt: addr put: value. self pop: 3 thenPush: valueOop "pop all; return value" !
Item was added: + ----- Method: Spur32BitMMLESimulator>>intAt:put: (in category 'memory access') ----- + intAt: byteAddress put: a32BitValue + ^self longAt: byteAddress put: (a32BitValue bitAnd: 16rFFFFFFFF)!
Item was added: + ----- Method: Spur32BitMMLESimulator>>storeInteger:ofObject:withValue: (in category 'simulation only') ----- + storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue!
Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." | sel | sel := thisContext sender method selector. (#( DoIt DoItIn: on:do: "from the debugger" makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: signed64BitValueOf: primDigitMultiply:negative: digitLength: isNegativeIntegerValueOf: magnitude64BitValueOf: primitiveMakePoint primitiveAsCharacter primitiveInputSemaphore baseFrameReturn primitiveExternalCall primDigitCompare: isLiveContext: numPointerSlotsOf: fileValueOf: loadBitBltDestForm fetchIntOrFloat:ofObject:ifNil: fetchIntOrFloat:ofObject: loadBitBltSourceForm loadPoint:from: primDigitAdd: primDigitSubtract: + positive64BitValueOf: + digitBitLogic:with:opIndex: + signed32BitValueOf:) includes: sel) ifFalse: - positive64BitValueOf:) includes: sel) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0!
Item was changed: ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') ----- longPrintOop: oop <api> | class fmt lastIndex startIP bytecodesPerLine column | ((objectMemory isImmediate: oop) or: [(objectMemory addressCouldBeObj: oop) not or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 or: [(objectMemory isFreeObject: oop) or: [objectMemory isForwarded: oop]]]]) ifTrue: [^self printOop: oop]. class := objectMemory fetchClassOfNonImm: oop. self printHex: oop; print: ': a(n) '; printNameOfClass: class count: 5; print: ' ('; printHex: class; print: ')'. fmt := objectMemory formatOf: oop. + self print: ' format '; printHexnp: fmt. - self print: ' format '; printHex: fmt. fmt > objectMemory lastPointerFormat ifTrue: [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)]. objectMemory printHeaderTypeOf: oop. + self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop). - self print: ' hash '; printHex: (objectMemory rawHashBitsOf: oop). self cr. (fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: [^self]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:i| | fieldOop | fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop. self space; printNum: i - 1; space; printHex: fieldOop; space. (i = 1 and: [objectMemory isCompiledMethod: oop]) ifTrue: [self printMethodHeaderOop: fieldOop] ifFalse: [self printOopShort: fieldOop]. self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > 64 ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * BytesPerWord + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 100 ifTrue: [lastIndex := startIP + 100]. bytecodesPerLine := 8. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: [self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)' inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", byte,byte)' inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte]. column := column + 1. column > bytecodesPerLine ifTrue: [column := 1. self cr]]. column = 1 ifFalse: [self cr]]!
Item was changed: ----- Method: StackInterpreter>>printCallStackOf: (in category 'debug printing') ----- + printCallStackOf: aContextOrProcessOrFrame - printCallStackOf: aContextOrProcess <api> | context | <inline: false> <var: #theFP type: #'char *'> + (stackPages couldBeFramePointer: aContextOrProcessOrFrame) ifTrue: + [^self printCallStackFP: (self cCoerceSimple: aContextOrProcessOrFrame to: #'char *')]. + ((objectMemory isContext: aContextOrProcessOrFrame) not + and: [(objectMemory lengthOf: aContextOrProcessOrFrame) > MyListIndex - ((objectMemory isContext: aContextOrProcess) not - and: [(objectMemory lengthOf: aContextOrProcess) > MyListIndex and: [objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex + ofObject: aContextOrProcessOrFrame)]]) ifTrue: - ofObject: aContextOrProcess)]]) ifTrue: [^self printCallStackOf: (objectMemory fetchPointer: SuspendedContextIndex + ofObject: aContextOrProcessOrFrame)]. + context := aContextOrProcessOrFrame. - ofObject: aContextOrProcess)]. - context := aContextOrProcess. [context = objectMemory nilObject] whileFalse: [(self isMarriedOrWidowedContext: context) ifTrue: [(self checkIsStillMarriedContext: context currentFP: framePointer) ifFalse: [self shortPrintContext: context. ^nil]. context := self shortReversePrintFrameAndCallers: (self frameOfMarriedContext: context)] ifFalse: [context := self printContextCallStackOf: context]]!
Item was added: + ----- Method: StackInterpreter>>printHexnp: (in category 'debug printing') ----- + printHexnp: n + "Print n in hex, in the form '0x1234', unpadded" + self print: '0x%x' f: n!
Item was added: + ----- Method: StackInterpreter>>printStackCallStack (in category 'debug printing') ----- + printStackCallStack + <doNotGenerate> + | theFP context | + theFP := localFP. + [context := self shortReversePrintFrameAndCallers: theFP. + ((self isMarriedOrWidowedContext: context) + and: [self checkIsStillMarriedContext: context currentFP: localFP]) ifFalse: + [^nil]. + theFP := self frameOfMarriedContext: context] repeat!
Item was added: + ----- Method: StackInterpreterSimulator>>printHexnp: (in category 'debug printing') ----- + printHexnp: anInteger + + traceOn ifTrue: + [transcript nextPutAll: (anInteger storeStringBase: 16)]!
Item was changed: ----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') ----- utilitiesMenu: aMenuMorph aMenuMorph add: 'toggle transcript' action: #toggleTranscript; addLine; add: 'print ext head frame' action: #printExternalHeadFrame; add: 'print int head frame' action: #printHeadFrame; add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer]; add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP]; add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer]; add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP]; add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]]; add: 'print call stack' action: #printCallStack; + add: 'print stack call stack' action: #printStackCallStack; add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]]; add: 'print all stacks' action: #printAllStacks; + add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP. + self writeBackHeadFramePointers]; addLine; add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]]; add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]]; addLine; add: 'inspect object memory' target: objectMemory action: #inspect; add: 'inspect cointerpreter' action: #inspect; addLine; add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'. s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]]; add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'. s notEmpty ifTrue: [self setBreakSelector: s]]; add: (printSends ifTrue: ['no print sends'] ifFalse: ['print sends']) action: [self ensureDebugAtEachStepBlock. printSends := printSends not]; "currently printReturns does nothing" "add: (printReturns ifTrue: ['no print returns'] ifFalse: ['print returns']) action: [self ensureDebugAtEachStepBlock. printReturns := printReturns not];" add: (printBytecodeAtEachStep ifTrue: ['no print bytecode each bytecode'] ifFalse: ['print bytecode each bytecode']) action: [self ensureDebugAtEachStepBlock. printBytecodeAtEachStep := printBytecodeAtEachStep not]; add: (printFrameAtEachStep ifTrue: ['no print frame each bytecode'] ifFalse: ['print frame each bytecode']) action: [self ensureDebugAtEachStepBlock. printFrameAtEachStep := printFrameAtEachStep not]. ^aMenuMorph!
vm-dev@lists.squeakfoundation.org