[Vm-dev] VM Maker: VMMaker.oscog-eem.202.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Aug 14 23:34:30 UTC 2012
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.202.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.202
Author: eem
Time: 14 August 2012, 4:31:58.12 pm
UUID: 3222e5fb-4b4b-4f71-b66a-10728b2fdf3d
Ancestors: VMMaker.oscog-eem.201
Eliminate some warnings in cointerp using gcc.
Fix the Gnuifier (register decls need to include the register keyword).
Expand cppIf: at translation time if the xpression is a variable in the
options dictionary, to cut down on e.g. noise of
MULTIPLEBYTECODESETS expansion of fetchNextBytecode..
=============== Diff against VMMaker.oscog-eem.201 ===============
Item was changed:
Object subclass: #CCodeGenerator
+ instanceVariableNames: 'vmClass translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors logger asmLabelCounts pools selectorTranslations optionsDictionary'
- instanceVariableNames: 'vmClass translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors logger asmLabelCounts pools selectorTranslations'
classVariableNames: 'UseRightShiftForDivide'
poolDictionaries: 'VMBasicConstants'
category: 'VMMaker-Translation to C'!
!CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.
See VMMaker for more useful info!
Item was changed:
----- Method: CCodeGenerator>>generateInlineCppIfElse:asArgument:on:indent: (in category 'C translation') -----
generateInlineCppIfElse: msgNode asArgument: asArgument on: aStream indent: level
"Generate the C code for this message onto the given stream."
| expr putStatement |
+ "Compile-time expansion for constants set in the options dictionary,
+ e.g. to cut down on noise for MULTIPLEBYTECODESETS."
+ putStatement := asArgument
+ ifTrue: "emitCCodeAsArgumentOn: doesn't indent, the code needs indenting if it takes multiple lines, so post-process."
+ [[:node| | expansion |
+ expansion := String streamContents: [:s| node emitCCodeAsArgumentOn: s level: level generator: self].
+ aStream nextPutAll:
+ ((expansion includes: Character cr)
+ ifTrue:
+ [(String streamContents:
+ [:s|
+ s next: level + 1 put: Character tab.
+ node emitCCodeAsArgumentOn: s level: level generator: self])
+ copyReplaceAll: (String with: Character cr)
+ with: (String with: Character cr), (String new: level + 1 withAll: Character tab)]
+ ifFalse: [expansion])]]
+ ifFalse:
+ [[:node| | expansion |
+ expansion := String streamContents: [:s| node emitCCodeOn: s level: level generator: self].
+ "Remove tabs from first line to avoid indenting a second time"
+ (aStream position > 0 and: [aStream last ~= Character tab]) ifTrue:
+ [expansion := expansion allButFirst: (expansion findFirst: [:c| c ~~ Character tab]) - 1].
+ aStream nextPutAll: expansion]].
- expr := String streamContents:
- [:es|
- msgNode args first
- emitCCodeAsArgumentOn: es
- level: 0
- generator: self].
- [expr last isSeparator] whileTrue:
- [expr := expr allButLast].
- aStream
- ensureCr;
- nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'if '; nextPutAll: expr; cr.
+ (msgNode args first isConstant
+ and: [#(true false) includes: (optionsDictionary at: msgNode args first name ifAbsent: [nil])]) ifTrue:
+ [(optionsDictionary at: msgNode args first name)
+ ifTrue:
+ [putStatement value: msgNode args second]
+ ifFalse:
+ [msgNode args size >= 3 ifTrue:
+ [putStatement value: msgNode args third]].
+ ^self].
+
+ "Full #if ... #else..."
putStatement := asArgument
ifTrue: "emitCCodeAsArgumentOn: doesn't indent, the code needs indenting in this case, so post-process."
[[:node|
aStream nextPutAll:
((String streamContents:
[:s|
s next: level + 1 put: Character tab.
node emitCCodeAsArgumentOn: s level: level generator: self])
copyReplaceAll: (String with: Character cr)
with: (String with: Character cr), (String new: level + 1 withAll: Character tab))]]
ifFalse:
[[:node| node emitCCodeOn: aStream level: level generator: self]].
+ expr := String streamContents:
+ [:es|
+ msgNode args first
+ emitCCodeAsArgumentOn: es
+ level: 0
+ generator: self].
+ [expr last isSeparator] whileTrue:
+ [expr := expr allButLast].
+ aStream
+ ensureCr;
+ nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'if '; nextPutAll: expr; cr.
+
putStatement value: msgNode args second.
expr := ' /* ', expr, ' */'.
msgNode args size >= 3 ifTrue:
[aStream
ensureCr;
nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'else'; nextPutAll: expr;
cr.
putStatement value: msgNode args third].
aStream
ensureCr;
nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'endif'; nextPutAll: expr;
cr.
asArgument ifTrue:
[aStream next: level + 1 put: Character tab]!
Item was added:
+ ----- Method: CCodeGenerator>>options (in category 'accessing') -----
+ options
+ ^optionsDictionary!
Item was added:
+ ----- Method: CCodeGenerator>>options: (in category 'accessing') -----
+ options: aDictionary
+ optionsDictionary := aDictionary!
Item was changed:
----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr
minimumMemory heapSize bytesRead bytesToShift
hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize |
<var: #f type: 'sqImageFile '>
<var: #memStart type: 'usqInt'>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
metaclassSizeBits := 6 * BytesPerWord. "guess (Metaclass instSize * BPW)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getLongFromFile: f swap: swapBytes. "N.B. not used."
hdrNumStackPages := self getShortFromFile: 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.
Can be set as a preference (Info.plist, VM.ini, command line etc).
If desiredNumStackPages is already non-zero then it has been
set as a preference. Ignore (but preserve) the header's default."
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
cogCodeSize := desiredCogCodeSize ~= 0
ifTrue: [desiredCogCodeSize]
ifFalse:
[hdrCogCodeSize = 0
ifTrue: [self defaultCogCodeSize]
ifFalse: [hdrCogCodeSize]].
hdrEdenBytes := self getLongFromFile: f swap: swapBytes.
objectMemory edenBytes: (desiredEdenBytes ~= 0
ifTrue: [desiredEdenBytes]
ifFalse:
[hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]]).
desiredEdenBytes := hdrEdenBytes.
hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
hdrMaxExtSemTabSize ~= 0 ifTrue:
[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
"compare memory requirements with availability"
minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ dataSize
+ objectMemory edenBytes
+ self interpreterAllocationReserveBytes.
heapSize := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ desiredHeapSize
"+ edenBytes" "don't include edenBytes; this is part of the heap and so part of desiredHeapSize"
+ self interpreterAllocationReserveBytes.
heapSize < minimumMemory ifTrue:
[self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
"N.B. If the platform needs to it will redefine this macro to make heapSize
an in/out parameter and assign the ammount actually allocated into heapSize.
See e.g. platforms/Mac OS/vm/sqPlatformSpecific.h. (I *hate* this. eem 7/23/2009)"
"objectMemory memory: (self cCode: 'sqAllocateMemory(minimumMemory, heapSize)'). "
objectMemory memory: (self
allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
+ headerSize: headerSize) asUnsignedInteger.
- headerSize: headerSize).
objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
heapBase := objectMemory memory + cogCodeSize.
self assert: objectMemory startOfMemory = heapBase.
objectMemory setMemoryLimit: objectMemory memory + heapSize - 24. "decrease memoryLimit a tad for safety"
objectMemory setEndOfMemory: heapBase + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := self cCode: 'sqImageFileRead(pointerForOop(heapBase), sizeof(unsigned char), dataSize, f)'.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
self ensureImageFormatIsUpToDate: swapBytes.
"compute difference between old and new memory base addresses"
bytesToShift := heapBase - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
self initializeCodeGenerator.
^dataSize!
Item was changed:
----- Method: CrossPlatformVMMaker>>createCodeGenerator (in category 'initialize') -----
createCodeGenerator
"Set up a CCodeGenerator for this VMMaker - A cross platform tree leaves it up to the makefiles to decide whether to use the global struct or not."
^CCodeGeneratorGlobalStructure new initialize;
globalStructDefined: true;
structDefDefine: 'USE_GLOBAL_STRUCT';
logger: logger;
+ options: optionsDictionary;
yourself!
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;' ].
- outLine := ' char* localIP IP_REG;' ].
(inLine findString: ' localFP;') > 0 ifTrue: [
+ outLine := ' register char* localFP FP_REG;' ].
- outLine := ' char* localFP FP_REG;' ].
(inLine findString: ' localSP;') > 0 ifTrue: [
+ outLine := ' register char* localSP SP_REG;' ].
- outLine := ' char* localSP SP_REG;' ].
(inLine findString: ' currentBytecode;') > 0 ifTrue: [
+ outLine := ' register sqInt currentBytecode CB_REG;' ].
- outLine := ' sqInt currentBytecode CB_REG;' ].
inLine isEmpty ifTrue: [
"reached end of variables"
inInterpretVars := false.
outLine := ' JUMP_TABLE;'.
extraOutLine := inLine ] ]
ifFalse: [
inInterpret ifTrue: [
"working inside interpret(); translate the switch statement"
(inLine beginsWith: ' case ') ifTrue: [
| caseLabel |
caseLabel := (inLine findTokens: ' :') second.
outLine := ' CASE(', caseLabel, ')' ].
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: Interpreter>>printOop: (in category 'debug printing') -----
printOop: oop
| fmt lastIndex |
<inline: false>
self printNum: oop.
(self isIntegerObject: oop) ifTrue:
+ [^self cCode: 'printf("=%ld\n", (long)integerValueOf(oop))' inSmalltalk: [self shortPrint: oop]].
- [^self cCode: 'printf("=%ld\n", integerValueOf(oop))' inSmalltalk: [self shortPrint: oop]].
self print: ': a(n) '.
self printNameOfClass: (self fetchClassOf: oop) count: 5.
self cr.
fmt := self formatOf: oop.
(fmt > 4 and: [fmt < 12]) ifTrue:
[^self printStringOf: oop].
lastIndex := 64 min: ((self lastPointerOf: oop) / BytesPerWord).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: 'printf(" %ld", fetchPointerofObject(index - 1, oop))'
inSmalltalk: [self space; print: (self fetchPointer: index - 1 ofObject: oop) printString; space.
self print: (self shortPrint: (self fetchPointer: index - 1 ofObject: oop))].
(index \\ 8) = 0 ifTrue:
[self cr]].
(lastIndex \\ 8) = 0 ifFalse:
[self cr]]!
Item was changed:
----- Method: NewspeakInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
| cls fmt lastIndex startIP bytecodesPerLine |
<inline: false>
self printHex: oop.
(self isIntegerObject: oop) ifTrue:
[^self
+ cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
- cCode: 'printf("=%ld\n", integerValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
(oop between: self startOfMemory and: freeBlock) ifFalse:
[self printHex: oop; print: ' is not on the heap'; cr.
^nil].
(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
[self printHex: oop; print: ' is misaligned'; cr.
^nil].
(self isFreeObject: oop) ifTrue:
[self print: ' free chunk of size '; printNum: (self sizeOfFree: oop); cr.
^nil].
self print: ': a(n) '.
self printNameOfClass: (cls := self fetchClassOfNonInt: oop) count: 5.
cls = (self splObj: ClassFloat) ifTrue:
[self cr; printFloat: (self dbgFloatValueOf: oop); cr.
^nil].
fmt := self formatOf: oop.
fmt > 4 ifTrue:
[self print: ' nbytes '; printNum: (self byteSizeOf: oop)].
self cr.
(fmt > 4 and: [fmt < 12]) ifTrue:
[(self isWords: oop) ifTrue:
[lastIndex := 64 min: ((self byteSizeOf: oop) / BytesPerWord).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self space; printHex: (self fetchLong32: index - 1 ofObject: oop).
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
^nil].
^self printStringOf: oop; cr].
lastIndex := 64 min: (startIP := (self lastPointerOf: oop) / BytesPerWord).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: 'printHex(fetchPointerofObject(index - 1, oop)); putchar('' '')'
inSmalltalk: [self space; printHex: (self fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (self fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
(self isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * BytesPerWord + 1.
lastIndex := self lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 10.
startIP to: lastIndex do:
[:index| | byte |
byte := self fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
[self cr]].
((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 ifFalse:
[self cr]]!
Item was changed:
----- Method: NewspeakInterpreter>>shortPrintOop: (in category 'debug printing') -----
shortPrintOop: oop
<inline: false>
self printHex: oop.
(self isIntegerObject: oop) ifTrue:
+ [^self cCode: 'printf("=%ld\n", (long)integerValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]].
- [^self cCode: 'printf("=%ld\n", integerValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]].
(oop between: self startOfMemory and: freeBlock) ifFalse:
[self printHex: oop; print: ' is not on the heap'; cr.
^nil].
(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
[self printHex: oop; print: ' is misaligned'; cr.
^nil].
self print: ': a(n) '.
self printNameOfClass: (self fetchClassOf: oop) count: 5.
self cr!
Item was changed:
----- Method: StackInterpreter>>marryFrame:SP: (in category 'frame access') -----
marryFrame: theFP SP: theSP
"Marry an unmarried frame. This means creating a spouse context
initialized with a subset of the frame's state (state through the last argument)
that references the frame."
+ <var: #theFP type: #'char *'>
+ <var: #theSP type: #'char *'>
<inline: false>
^self marryFrame: theFP SP: theSP copyTemps: false!
Item was changed:
----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
| cls fmt lastIndex startIP bytecodesPerLine |
<inline: false>
self printHex: oop.
(objectMemory isIntegerObject: oop) ifTrue:
[^self
+ cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
- cCode: 'printf("=%ld\n", integerValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
[self printHex: oop; print: ' is not on the heap'; cr.
^nil].
(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
[self printHex: oop; print: ' is misaligned'; cr.
^nil].
(objectMemory isFreeObject: oop) ifTrue:
[self print: ' free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr.
^nil].
self print: ': a(n) '.
self printNameOfClass: (cls := objectMemory fetchClassOfNonInt: oop) count: 5.
cls = (objectMemory splObj: ClassFloat) ifTrue:
[self cr; printFloat: (self dbgFloatValueOf: oop); cr.
^nil].
fmt := objectMemory formatOf: oop.
fmt > 4 ifTrue:
[self print: ' nbytes '; printNum: (objectMemory byteSizeOf: oop)].
self cr.
(fmt > 4 and: [fmt < 12]) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
self print: ((self isIndirectAlien: oop)
ifTrue: [' indirect @ ']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: [' pointer @ ']
ifFalse: [' direct @ ']]).
self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr.
^nil].
(objectMemory isWords: oop) ifTrue:
[lastIndex := 64 min: ((objectMemory byteSizeOf: oop) / BytesPerWord).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
^nil].
^self printStringOf: oop; cr].
lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: 'printHex(fetchPointerofObject(index - 1, oop)); putchar('' '')'
inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[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 := 10.
startIP to: lastIndex do:
[:index| | byte |
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
[self cr]].
((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 ifFalse:
[self cr]]!
Item was changed:
----- Method: StackInterpreter>>shortPrintContext: (in category 'debug printing') -----
shortPrintContext: aContext
| theFP |
<inline: false>
<var: #theFP type: #'char *'>
(self isContext: aContext) ifFalse:
[self printHex: aContext; print: ' is not a context'; cr.
^nil].
self printHex: aContext.
(self isMarriedOrWidowedContext: aContext)
ifTrue: [(self checkIsStillMarriedContext: aContext currentFP: framePointer)
ifTrue:
[(self isMachineCodeFrame: (theFP := self frameOfMarriedContext: aContext))
ifTrue: [self print: ' M (']
ifFalse: [self print: ' I ('].
+ self printHex: theFP asUnsignedInteger; print: ') ']
- self printHex: theFP; print: ') ']
ifFalse:
[self print: ' w ']]
ifFalse: [self print: ' s '].
(self findHomeForContext: aContext)
ifNil: [self print: ' BOGUS CONTEXT (can''t determine home)']
ifNotNil:
[:home|
self printActivationNameFor: (objectMemory fetchPointer: MethodIndex ofObject: aContext)
receiver: (home isNil
ifTrue: [objectMemory nilObject]
ifFalse: [objectMemory fetchPointer: ReceiverIndex ofObject: home])
isBlock: home ~= aContext
firstTemporary: (objectMemory fetchPointer: 0 + CtxtTempFrameStart ofObject: home)].
self cr!
Item was changed:
----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
shortPrintOop: oop
<inline: false>
self printNum: oop.
(objectMemory isIntegerObject: oop) ifTrue:
+ [^self cCode: 'printf("=%ld\n", (long)integerValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]].
- [^self cCode: 'printf("=%ld\n", integerValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]].
(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
[self printHex: oop; print: ' is not on the heap'; cr.
^nil].
(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
[self printHex: oop; print: ' is misaligned'; cr.
^nil].
self print: ': a(n) '.
self printNameOfClass: (objectMemory fetchClassOf: oop) count: 5.
self cr!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveContextAtPut (in category 'indexing primitives') -----
primitiveContextAtPut
"Special version of primitiveAtPut for accessing contexts.
Written to be varargs for use from mirror primitives."
| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
<inline: false>
<var: #spouseFP type: #'char *'>
value := self stackTop.
index := self stackValue: 1.
aContext := self stackValue: 2.
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
hdr := objectMemory baseHeader: aContext.
index := objectMemory integerValueOf: index.
(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
[self stObject: aContext at: index put: value.
^self successful ifTrue:
[self pop: argumentCount + 1 thenPush: value]].
self externalWriteBackHeadFramePointers.
(self isStillMarriedContext: aContext) ifFalse:
[fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: aContext baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
stSize := self fetchStackPointerOf: aContext.
(index between: 1 and: stSize) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
self subscript: aContext with: (index + fixedFields) storing: value format: fmt.
^self pop: argumentCount + 1 thenPush: value].
spouseFP := self frameOfMarriedContext: aContext.
(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
self temporary: index - 1 in: spouseFP put: value.
+ self pop: argumentCount + 1 thenPush: value!
- ^self pop: argumentCount + 1 thenPush: value!
Item was changed:
----- Method: VMMaker class>>generateNewspeakCogVM (in category 'configurations') -----
generateNewspeakCogVM
^VMMaker
generate: CoInterpreter
and: StackToRegisterMappingCogit"Cogit chooseCogitClass"
+ with: #( NewspeakVM true
+ MULTIPLEBYTECODESETS false)
- with: #(NewspeakVM true)
to: (FileDirectory default pathFromURI: 'oscogvm/nscogsrc')
platformDir: (FileDirectory default pathFromURI: '../Newspeak/newclosurevm/platforms')
including:#( AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation DSAPlugin DropPlugin
FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin InflatePlugin JPEGReadWriter2Plugin
JPEGReaderPlugin LargeIntegersPlugin Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin
RePlugin SecurityPlugin SocketPlugin SoundPlugin SurfacePlugin ThreadedIA32FFIPlugin
UUIDPlugin UnixOSProcessPlugin VMProfileMacSupportPlugin Win32OSProcessPlugin)!
Item was changed:
----- Method: VMMaker class>>generateSqueakCogVM (in category 'configurations') -----
generateSqueakCogVM
^VMMaker
generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]]
value: #(CoInterpreter CoInterpreterMT)))
and: StackToRegisterMappingCogit
+ with: #( MULTIPLEBYTECODESETS false
+ NewspeakVM false)
to: (FileDirectory default pathFromURI: 'oscogvm/src')
platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms')
including:#( ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin
BMPReadWriterPlugin BitBltSimulation BochsIA32Plugin CroquetPlugin DSAPlugin
DeflatePlugin DropPlugin FT2Plugin FFTPlugin FileCopyPlugin FilePlugin FloatArrayPlugin
FloatMathPlugin GeniePlugin HostWindowPlugin IA32ABIPlugin InternetConfigPlugin
JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin SecurityPlugin SerialPlugin
SocketPlugin SoundCodecPlugin SoundGenerationPlugin SoundPlugin ThreadedIA32FFIPlugin
StarSqueakPlugin UUIDPlugin UnixOSProcessPlugin Win32OSProcessPlugin VMProfileMacSupportPlugin)!
Item was changed:
----- Method: VMMaker>>createCodeGenerator (in category 'initialize') -----
createCodeGenerator
"set up a CCodeGenerator for this VMMaker"
^CCodeGenerator new initialize
logger: logger;
+ options: optionsDictionary;
yourself!
Item was changed:
----- Method: VMMaker>>createCogitCodeGenerator (in category 'initialize') -----
createCogitCodeGenerator
^CCodeGenerator new initialize
logger: logger;
+ options: optionsDictionary;
yourself!
Item was added:
+ ----- Method: VMMaker>>options (in category 'accessing') -----
+ options
+ ^optionsDictionary!
More information about the Vm-dev
mailing list