Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3375.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3375 Author: eem Time: 12 May 2024, 5:08:17.921052 pm UUID: f5ac2627-c6fa-4468-b11e-a67fde7fb22a Ancestors: VMMaker.oscog-eem.3374
Cleanups: fix all (clang) format warnings in the 64-bit cointerpreter and cogit. Add asCharPointer to help. Deprecate asCharPtr (the only example of an implicit firstIndexableField invocation; note asIntPtr is not even implemented). Rewrite SocketPlugin>>#intToNetAddress: to avoid asCharPtr.
SocketPlugin Fix a few unchecked invocations of socketValueOf:. Simplify some methods to remove variables.
Simulation: Make StackInterpreter>>#openImageFileNamed: expand ~ when a file name missing the .inage extension is given.
=============== Diff against VMMaker.oscog-eem.3374 ===============
Item was added: + ----- Method: CCodeGenerator>>generateAsCharPointer:on:indent: (in category 'C translation') ----- + generateAsCharPointer: msgNode on: aStream indent: level + "Generate the C code for this message onto the given stream." + + aStream nextPutAll: '((char *)'. + self emitCExpression: msgNode receiver on: aStream. + aStream nextPut: $)!
Item was changed: ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') ----- initializeCTranslationDictionary "Initialize the dictionary mapping message names to actions for C code generation."
| pairs | translationDict := Dictionary new: 200. pairs := #( #& #generateAnd:on:indent: #| #generateOr:on:indent: #abs #generateAbs:on:indent: #and: #generateSequentialAnd:on:indent: #or: #generateSequentialOr:on:indent: #not #generateNot:on:indent:
#+ #generatePlus:on:indent: #- #generateMinus:on:indent: #negated #generateNegated:on:indent: #* #generateTimes:on:indent: #/ #generateDivide:on:indent: #// #generateDivide:on:indent: #\ #generateModulo:on:indent: #<< #generateShiftLeft:on:indent: #>> #generateShiftRight:on:indent: #>>> #generateSignedShiftRight:on:indent: #, #generateComma:on:indent: #min: #generateMin:on:indent: #max: #generateMax:on:indent: #between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent: #bitOr: #generateBitOr:on:indent: #bitXor: #generateBitXor:on:indent: #bitShift: #generateBitShift:on:indent: #signedBitShift: #generateSignedBitShift:on:indent: #bitInvert #generateBitInvert:on:indent: #bitInvert32 #generateBitInvert:on:indent: #bitInvert64 #generateBitInvert:on:indent: #bitClear: #generateBitClear:on:indent: #truncateTo: #generateTruncateTo:on:indent: #rounded #generateRounded:on:indent: #even #generateEven:on:indent: #odd #generateOdd:on:indent:
#byteSwap32 #generateByteSwap32:on:indent: #byteSwap64 #generateByteSwap64:on:indent: #byteSwapped32IfBigEndian: generateByteSwap32IfBigEndian:on:indent: #byteSwapped64IfBigEndian: generateByteSwap64IfBigEndian:on:indent: #< #generateLessThan:on:indent: #<= #generateLessThanOrEqual:on:indent: #= #generateEqual:on:indent: #> #generateGreaterThan:on:indent: #>= #generateGreaterThanOrEqual:on:indent: #~= #generateNotEqual:on:indent: #== #generateEqual:on:indent: #~~ #generateNotEqual:on:indent: #isNil #generateIsNil:on:indent: #notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent: #whileFalse: #generateWhileFalse:on:indent: #whileTrue #generateDoWhileTrue:on:indent: #whileFalse #generateDoWhileFalse:on:indent: #to:do: #generateToDo:on:indent: #to:by:do: #generateToByDo:on:indent: #repeat #generateRepeat:on:indent: #timesRepeat: #generateTimesRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent: #ifFalse: #generateIfFalse:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#ifNotNil: #generateIfNotNil:on:indent: #ifNil: #generateIfNil:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent:
#at: #generateAt:on:indent: #at:put: #generateAtPut:on:indent: #basicAt: #generateAt:on:indent: #basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent: #integerObjectOf: #generateIntegerObjectOf:on:indent: #isIntegerObject: #generateIsIntegerObject:on:indent: #cCode: #generateInlineCCode:on:indent: #cCode:inSmalltalk: #generateInlineCCode:on:indent: #cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent: #cppIf:ifTrue:cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent: #cppIf:ifTrue: #generateInlineCppIfElse:on:indent: #cppIf:ifFalse: #generateInlineCppIfElse:on:indent: #cCoerce:to: #generateCCoercion:on:indent: #cCoerceSimple:to: #generateCCoercion:on:indent: #addressOf: #generateAddressOf:on:indent: #addressOf:put: #generateAddressOf:on:indent: #asAddress:put: #generateAsAddress:on:indent: #signedIntFromLong64 #generateSignedIntFromLong64:on:indent: #signedIntFromLong #generateSignedIntFromLong:on:indent: #signedIntFromShort #generateSignedIntFromShort:on:indent: #signedIntToLong64 #generateSignedIntToLong64:on:indent: #signedIntToLong #generateSignedIntToLong:on:indent: #signedIntToShort #generateSignedIntToShort:on:indent: #preIncrement #generatePreIncrement:on:indent: #preDecrement #generatePreDecrement:on:indent: #inline: #generateInlineDirective:on:indent: #asFloat #generateAsFloat:on:indent: #asInteger #generateAsInteger:on:indent: #asIntegerPtr #generateAsIntegerPtr:on:indent: #asUnsignedInteger #generateAsUnsignedInteger:on:indent: #asUnsignedIntegerPtr #generateAsUnsignedIntegerPtr:on:indent: #asLong #generateAsLong:on:indent: #asUnsignedLong #generateAsUnsignedLong:on:indent: #asUnsignedLongLong #generateAsUnsignedLongLong:on:indent: + #asCharPointer #generateAsCharPointer:on:indent: #asVoidPointer #generateAsVoidPointer:on:indent: #asSymbol #generateAsSymbol:on:indent: #asWideString #generateAsWideString:on:indent: #flag: #generateFlag:on:indent: #anyMask: #generateAnyMask:on:indent: #allMask: #generateAllMask:on:indent: #noMask: #generateNoMask:on:indent: #raisedTo: #generateRaisedTo:on:indent: #touch: #generateTouch:on:indent:
#bytesPerOop #generateBytesPerOop:on:indent: #bytesPerWord #generateBytesPerWord:on:indent: #wordSize #generateBytesPerWord:on:indent: #baseHeaderSize #generateBaseHeaderSize:on:indent: #minSmallInteger #generateSmallIntegerConstant:on:indent: #maxSmallInteger #generateSmallIntegerConstant:on:indent: #perform: #generatePerform:on:indent: #perform:with: #generatePerform:on:indent: #perform:with:with: #generatePerform:on:indent: #perform:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent: #value: #generateValue:on:indent: #value:value: #generateValue:on:indent: #value:value:value: #generateValue:on:indent: #value:value:value:value: #generateValue:on:indent: #value:value:value:value:value: #generateValue:on:indent: #value:value:value:value:value:value: #generateValue:on:indent:
#deny: #generateDeny:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent: #shouldBeImplemented #generateSmalltalkMetaError:on:indent: #subclassResponsibility #generateSmalltalkMetaError:on:indent:
#strlen: #generateStrlen:on:indent: ).
1 to: pairs size by: 2 do: [:i | translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #( #ifTrue: #generateIfTrueAsArgument:on:indent: #ifFalse: #generateIfFalseAsArgument:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent: #ifNotNil: #generateIfNotNilAsArgument:on:indent: #ifNil: #generateIfNilAsArgument:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent: #cCode: #generateInlineCCodeAsArgument:on:indent: #cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent: #cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent:
#value #generateValueAsArgument:on:indent: #value: #generateValueAsArgument:on:indent: #value:value: #generateValueAsArgument:on:indent: ).
asArgumentTranslationDict := Dictionary new: 8. 1 to: pairs size by: 2 do: [:i | asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)]. !
Item was changed: ----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') ----- printMethodCacheFor: thing <public> "useful for VM debugging" | n | n := 0. 0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do: [:i | | s c m p | s := methodCache at: i + MethodCacheSelector. c := methodCache at: i + MethodCacheClass. m := methodCache at: i + MethodCacheMethod. p := methodCache at: i + MethodCachePrimFunction. ((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing or: [(objectMemory addressCouldBeObj: m) and: [(self maybeMethodHasCogMethod: m) and: [(self cogMethodOf: m) asInteger = thing]]]]]]]) and: [(objectMemory addressCouldBeOop: s) and: [c ~= 0 and: [(self addressCouldBeClassObj: c) or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue: [n := n + 1. self cCode: nil inSmalltalk: [self transcript ensureCr]. '%ld %lx\n\t' f: transcript printf: { i. i }. (objectMemory isBytesNonImm: s) + ifTrue: ['%P %.*s\n' f: transcript printf: { s asVoidPointer. objectMemory numBytesOfBytes: s. (objectMemory firstIndexableField: s) asCharPointer }] - ifTrue: ['%P %.*s\n' f: transcript printf: { s asVoidPointer. objectMemory numBytesOfBytes: s. objectMemory firstIndexableField: s }] ifFalse: [self shortPrintOop: s]. self tab. (self addressCouldBeClassObj: c) ifTrue: [self shortPrintOop: c] ifFalse: [self printNum: c; space; printHexnp: c; space; shortPrintOop: (objectMemory classForClassTag: c)]. self tab; shortPrintOop: m; tab. self cCode: [p > 1024 ifTrue: [self printHexnp: p] ifFalse: [self printNum: p]] inSmalltalk: [p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]]. self cr]]. n > 1 ifTrue: [self printNum: n; cr]!
Item was changed: ----- Method: CoInterpreter>>printPrimLogEntryAt:hasParameter: (in category 'debug support') ----- printPrimLogEntryAt: i hasParameter: hasParameter <inline: false> "print the entry and answer if it takes a parameter (as the following entry)" | entryOop className length | entryOop := primTraceLog at: i. hasParameter ifTrue: [(objectMemory addressCouldBeObj: entryOop) ifTrue: [className := self nameOfClass: entryOop lengthInto: (self addressOf: length put: [:v| length := v])] ifFalse: [className := 'bad class'. length := 9]. '%.*s\n' f: transcript printf: { length. className }. ^false]. (objectMemory isImmediate: entryOop) ifTrue: [entryOop = TraceIncrementalGC ifTrue: [self print: '**IncrementalGC**\n'. ^false]. entryOop = TraceFullGC ifTrue: [self print: '**FullGC**\n'. ^false]. entryOop = TraceCodeCompaction ifTrue: [self print: '**CompactCode**\n'. ^false]. entryOop = TraceStackOverflow ifTrue: [self print: '**StackOverflow**\n'. ^false]. entryOop = TracePrimitiveFailure ifTrue: [self print: '**PrimitiveFailure** '. ^true]. entryOop = TracePrimitiveRetry ifTrue: [self print: '**PrimitiveRetry**\n'. ^false]. self print: '???\n'] ifFalse: [(objectMemory addressCouldBeObj: entryOop) ifFalse: ['%ld!!!!!!\n' f: transcript printf: i] ifTrue: [(objectMemory isCompiledMethod: entryOop) ifTrue: [| methodClass methodSel | className := '???'. length := 3. methodClass := self safeMethodClassOf: entryOop. methodClass ~= objectMemory nilObject ifTrue: [className := self nameOfClass: methodClass lengthInto: (self addressOf: length put: [:v| length := v])]. methodSel := self findSelectorOfMethod: entryOop. methodSel = objectMemory nilObject ifTrue: ['%.*s>>(selector not found)\n' f: transcript printf: { length. className }] ifFalse: ['%.*s>>#%.*s\n' f: transcript printf: { length. className. + objectMemory numBytesOfBytes: methodSel. (objectMemory firstIndexableField: methodSel) asCharPointer }]] - objectMemory numBytesOfBytes: methodSel. objectMemory firstIndexableField: methodSel }]] ifFalse: [objectMemory safePrintStringOf: entryOop. self cr]]]. ^false!
Item was changed: ----- Method: Cogit>>printTrampolineTable (in category 'debugging') ----- printTrampolineTable <public> "useful for debugging" 0 to: trampolineTableIndex - 1 by: 2 do: + [:i| '%P: %s\n' f: coInterpreter getTranscript printf: { (trampolineAddresses at: i + 1) asVoidPointer. (trampolineAddresses at: i) asCharPointer }]! - [:i| - coInterpreter - printHex: (trampolineAddresses at: i + 1) asInteger; - print: ': '; - print: (self cCoerceSimple: (trampolineAddresses at: i) to: #'char *'); - cr]!
Item was added: + ----- Method: Integer>>asCharPointer (in category '*VMMaker-interpreter simulator') ----- + asCharPointer + ^self!
Item was changed: ----- Method: Integer>>asCharPtr (in category '*VMMaker-interpreter simulator') ----- asCharPtr + self deprecated. ^(Notification new tag: #getInterpreter; signal) ifNotNil: [:interpreter| (interpreter firstIndexableField: self) asInteger coerceTo: #'char *' sim: interpreter] ifNil: [self]!
Item was changed: ----- Method: InterpreterPrimitives>>traceInputEvent: (in category 'I/O primitive support') ----- traceInputEvent: evtBuf <var: #evtBuf declareC: 'sqIntptr_t evtBuf[8]'> | eventTypeNames | eventTypeNames := self cCoerce: #('None' 'Mouse' 'Keyboard' 'DragDropFiles' 'Menu' 'Window' 'Complex' 'MouseWheel' 'Plugin') to: #'char **'. + 'Event%s/%ld @ %lu\t\t%ld/%lx %ld/%lx\n\t%ld/%lx %ld/%lx\t %ld/%lx %p\n' - 'Event%s/%ld @ %u\t\t%ld/%x %ld/%x\n\t%ld/%x %ld/%x\t %ld/%x %p\n' f: #stderr printf: { ((evtBuf at: 0) between: 0 and: 8) ifTrue: [eventTypeNames at: (evtBuf at: 0)] ifFalse: ['?']. evtBuf at: 0. evtBuf at: 1. "timestamp" evtBuf at: 2. evtBuf at: 2. evtBuf at: 3. evtBuf at: 3. evtBuf at: 4. evtBuf at: 4. evtBuf at: 5. evtBuf at: 5. evtBuf at: 6. evtBuf at: 6. (evtBuf at: 7) asVoidPointer } "windowIndex"!
Item was changed: ----- Method: ObjectMemory>>printNonPointerDataOf:on: (in category 'debug printing interpreter support') ----- printNonPointerDataOf: oop on: aStream <var: 'aStream' type: #'FILE *'> | elementsPerLine format lastIndex | format := self formatOf: oop. self assert: (format between: self sixtyFourBitIndexableFormat and: self firstCompiledMethodFormat - 1). lastIndex := self lengthOf: oop format: format. lastIndex = 0 ifTrue: [^self]. format = self sixtyFourBitIndexableFormat ifTrue: [lastIndex := 32 min: lastIndex. elementsPerLine := 4. "0x/16r0123456789ABCDEF<space|cr> x 4 = 76/80" 1 to: lastIndex do: [:index| + '%19lX%c' f: aStream printf: { - '%19P%c' f: aStream printf: { self cCoerceSimple: (self fetchLong64: index - 1 ofObject: oop) to: #usqLong. (index \ elementsPerLine = 0 or: [index = lastIndex]) ifTrue: [Character cr] ifFalse: [Character space] }]. ^self]. format < self firstByteFormat ifTrue: [lastIndex := 128 min: lastIndex. elementsPerLine := 6. "0x/16r12345678<space|cr> x 6 = 66/72" 1 to: lastIndex do: [:index| '%11P%c' f: aStream printf: { self fetchLong32: index - 1 ofObject: oop. (index \ elementsPerLine = 0 or: [index = lastIndex]) ifTrue: [Character cr] ifFalse: [Character space] }]. ^self]. lastIndex := 256 min: lastIndex. elementsPerLine := 16. "0x/16r12<space|cr> x 16 = 80/96" 1 to: lastIndex do: [:index| '%5P%c' f: aStream printf: { self fetchByte: index - 1 ofObject: oop. (index \ elementsPerLine = 0 or: [index = lastIndex]) ifTrue: [Character cr] ifFalse: [Character space] }]!
Item was changed: ----- Method: ObjectMemory>>printStringDataOf:on: (in category 'debug printing interpreter support') ----- printStringDataOf: oop on: aStream <var: 'aStream' type: #'FILE *'> | i n limit | <var: 'buffer' type: #'char *'> <var: 'wideBuffer' type: #'unsigned int *'> (self isBytesNonImm: oop) ifTrue: [| buffer byte | + buffer := self cCoerce: (self alloca: 256 * 4) to: #'char *'. - buffer := self alloca: 256 * 4. n := i := 0. limit := (self numBytesOfBytes: oop) min: 256. + [n < limit] whileTrue: - [i < limit] whileTrue: [byte := self fetchByte: i ofObject: oop. i := i + 1. (byte < 32 "space" and: [byte ~= 9 "tab"]) ifTrue: [buffer at: n put: $<. n := n + 1. (byte = 10 or: [byte = 13]) ifTrue: [byte = 10 ifTrue: [buffer at: n put: $L; at: n + 1 put: $F] ifFalse: [buffer at: n put: $C; at: n + 1 put: $R]. n := n + 2] ifFalse: [byte >= 10 ifTrue: [buffer at: n put: byte // 10 + $0 asInteger. n := n + 1]. buffer at: n put: byte \ 10 + $0 asInteger. n := n + 1]. buffer at: n put: $>. n := n + 1] ifFalse: [buffer at: n put: byte. n := n + 1]]. '%.*s%s\n' f: aStream printf: { n. buffer. (self numBytesOfBytes: oop) > limit ifTrue: ['...'] ifFalse: [''] }] ifFalse: [| wideBuffer word | self assert: (self isWordsNonImm: oop). + wideBuffer := self cCoerce: (self alloca: 1024 * 4) to: #'int *'. - wideBuffer := self cCoerce: (self alloca: 1024 * 4) to: 'int *'. n := i := 0. limit := (self lengthOf: oop) min: 256. [i < limit] whileTrue: [word := self fetchLong32: i ofObject: oop. i := i + 1. (word < 32 "space" and: [word ~= 9 "tab"]) ifTrue: [wideBuffer at: n put: $<. n := n + 1. (word = 10 or: [word = 13]) ifTrue: [word = 10 ifTrue: [wideBuffer at: n put: $L; at: n + 1 put: $F] ifFalse: [wideBuffer at: n put: $C; at: n + 1 put: $R]. n := n + 2] ifFalse: [word >= 10 ifTrue: [wideBuffer at: n put: word // 10 + $0 asInteger. n := n + 1]. wideBuffer at: n put: word \ 10 + $0 asInteger. n := n + 1]. wideBuffer at: n put: $>. n := n + 1] ifFalse: [wideBuffer at: n put: word. n := n + 1]]. '%.*s%s\n' asWideString f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!
Item was changed: ----- Method: SocketPlugin>>intToNetAddress: (in category 'primitives') ----- intToNetAddress: addr "Convert the given 32-bit integer into an internet network address represented as a four-byte ByteArray."
| netAddressOop naPtr | + <var: #naPtr type: #'unsigned char * '> - <var: #naPtr type: 'char * '>
+ netAddressOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: 4. + naPtr := self cCoerce: (interpreterProxy firstIndexableField: netAddressOop) to: #'unsigned char *'. + naPtr at: 0 put: (addr >> 24 bitAnd: 16rFF). + naPtr at: 1 put: (addr >> 16 bitAnd: 16rFF). + naPtr at: 2 put: (addr >> 8 bitAnd: 16rFF). + naPtr at: 3 put: (addr bitAnd: 16rFF). + ^netAddressOop! - netAddressOop := - interpreterProxy instantiateClass: interpreterProxy classByteArray - indexableSize: 4. - naPtr := netAddressOop asCharPtr. - naPtr at: 0 put: (self cCoerce: ((addr >> 24) bitAnd: 16rFF) to: 'char'). - naPtr at: 1 put: (self cCoerce: ((addr >> 16) bitAnd: 16rFF) to: 'char'). - naPtr at: 2 put: (self cCoerce: ((addr >> 8) bitAnd: 16rFF) to: 'char'). - naPtr at: 3 put: (self cCoerce: (addr bitAnd: 16rFF) to: 'char'). - ^ netAddressOop!
Item was changed: ----- Method: SocketPlugin>>primitiveResolverAddressLookupResult (in category 'primitives') ----- primitiveResolverAddressLookupResult | sz s | self primitive: 'primitiveResolverAddressLookupResult'. sz := self sqResolverAddrLookupResultSize. + interpreterProxy failed ifFalse: + [s := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: sz. + self sqResolverAddrLookup: (interpreterProxy firstIndexableField: s) asCharPointer Result: sz]. + ^s! - - interpreterProxy failed - ifFalse: [s := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: sz. - self sqResolverAddrLookup: s asCharPtr Result: sz]. - ^ s!
Item was changed: ----- Method: SocketPlugin>>primitiveResolverLocalAddress (in category 'primitives') ----- primitiveResolverLocalAddress
- | addr | self primitive: 'primitiveResolverLocalAddress'. + ^self intToNetAddress: self sqResolverLocalAddress! - addr := self sqResolverLocalAddress. - ^self intToNetAddress: addr!
Item was changed: ----- Method: SocketPlugin>>primitiveResolverNameLookupResult (in category 'primitives') ----- primitiveResolverNameLookupResult
- | addr | self primitive: 'primitiveResolverNameLookupResult'. + ^self intToNetAddress: self sqResolverNameLookupResult! - addr := self sqResolverNameLookupResult. - ^self intToNetAddress: addr!
Item was changed: ----- Method: SocketPlugin>>primitiveSocketLocalAddress: (in category 'primitives') ----- primitiveSocketLocalAddress: socket
+ | s | + <var: #s type: #SocketPtr> - | s addr | - <var: #s type: 'SocketPtr'> self primitive: 'primitiveSocketLocalAddress' parameters: #(Oop). s := self socketValueOf: socket. + interpreterProxy failed ifFalse: + [^self intToNetAddress: (self sqSocketLocalAddress: s)]! - addr := self sqSocketLocalAddress: s. - ^self intToNetAddress: addr!
Item was changed: ----- Method: SocketPlugin>>primitiveSocketRemoteAddress: (in category 'primitives') ----- primitiveSocketRemoteAddress: socket
+ | s | + <var: #s type: #SocketPtr> - | s addr | - <var: #s type: 'SocketPtr'> self primitive: 'primitiveSocketRemoteAddress' parameters: #(Oop). s := self socketValueOf: socket. + interpreterProxy failed ifFalse: + [^self intToNetAddress: (self sqSocketRemoteAddress: s)]! - addr := self sqSocketRemoteAddress: s. - ^self intToNetAddress: addr!
Item was changed: ----- Method: SpurMemoryManager>>printBridge:on: (in category 'debug printing interpreter support') ----- printBridge: oop on: aStream <var: 'aStream' type: #'FILE *'> <inline: false> + '%P is a bridge hdr%d slot size %lu\n' - '%P is a bridge hdr%d slot size %ul\n' f: aStream printf: { oop asVoidPointer. (self hasOverflowHeader: oop) ifTrue: [16] ifFalse: [8]. self numSlotsOfAny: oop}!
Item was changed: ----- Method: SpurMemoryManager>>printForwarder:on: (in category 'debug printing interpreter support') ----- printForwarder: oop on: aStream <var: 'aStream' type: #'FILE *'> <inline: false> + '%P is a forwarded hdr%d slot size %lu object to %P\n' - '%P is a forwarded hdr%d slot size %ul object to %P\n' f: aStream printf: { oop asVoidPointer. (self hasOverflowHeader: oop) ifTrue: [16] ifFalse: [8]. self numSlotsOfAny: oop. (self followForwarded: oop) asVoidPointer}!
Item was changed: ----- Method: SpurMemoryManager>>printNonPointerDataOf:on: (in category 'debug printing interpreter support') ----- printNonPointerDataOf: oop on: aStream <var: 'aStream' type: #'FILE *'> | elementsPerLine format lastIndex | format := self formatOf: oop. self assert: (format between: self sixtyFourBitIndexableFormat and: self firstCompiledMethodFormat - 1). lastIndex := self lengthOf: oop format: format. lastIndex = 0 ifTrue: [^self]. format = self sixtyFourBitIndexableFormat ifTrue: [lastIndex := 32 min: lastIndex. elementsPerLine := 4. "0x/16r0123456789ABCDEF<space|cr> x 4 = 76/80" 1 to: lastIndex do: [:index| + '%19lX%c' f: aStream printf: { - '%19P%c' f: aStream printf: { self cCoerceSimple: (self fetchLong64: index - 1 ofObject: oop) to: #usqLong. (index \ elementsPerLine = 0 or: [index = lastIndex]) ifTrue: [Character cr] ifFalse: [Character space] }]. ^self]. format < self firstShortFormat ifTrue: [lastIndex := 64 min: lastIndex. elementsPerLine := 8. "0x/16r12345678<space|cr> x 8 = 80/88" 1 to: lastIndex do: [:index| '%11P%c' f: aStream printf: { (self fetchLong32: index - 1 ofObject: oop) asVoidPointer. (index \ elementsPerLine = 0 or: [index = lastIndex]) ifTrue: [Character cr] ifFalse: [Character space] }]. ^self]. format < self firstByteFormat ifTrue: [lastIndex := 128 min: lastIndex. elementsPerLine := 10. "0x/16r1234<space|cr> x 10 = 70/80" 1 to: lastIndex do: [:index| '%7P%c' f: aStream printf: { (self fetchShort16: index - 1 ofObject: oop) asVoidPointer. (index \ elementsPerLine = 0 or: [index = lastIndex]) ifTrue: [Character cr] ifFalse: [Character space] }]. ^self]. lastIndex := 256 min: lastIndex. elementsPerLine := 16. "0x/16r12<space|cr> x 16 = 80/96" 1 to: lastIndex do: [:index| '%5P%c' f: aStream printf: { (self fetchByte: index - 1 ofObject: oop) asVoidPointer. (index \ elementsPerLine = 0 or: [index = lastIndex]) ifTrue: [Character cr] ifFalse: [Character space] }]!
Item was changed: ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') ----- longPrintOop: oop <public> "useful for VM debugging" | fmt lastIndex startIP column cls |
(objectMemory isImmediate: oop) ifTrue: [^objectMemory printImmediateObject: oop on: transcript]. (objectMemory addressCouldBeObj: oop) ifFalse: [^objectMemory printCantBeObject: oop on: transcript]. (objectMemory isFreeObject: oop) ifTrue: [^objectMemory printFreeObject: oop on: transcript]. (objectMemory isForwarded: oop) ifTrue: [^objectMemory printForwarder: oop on: transcript]. (cls := objectMemory fetchClassOfNonImm: oop) ifNil: ['%P has a nil class!!!!\n' f: transcript printf: oop asVoidPointer] ifNotNil: [| className length | className := self nameOfClass: cls lengthInto: (self addressOf: length put: [:v| length := v]). '%P: a(n) %.*s' f: transcript printf: {oop asVoidPointer. length. className }. objectMemory hasSpurMemoryManagerAPI ifTrue: ['(%lx=>%P)' f: transcript printf: { objectMemory compactClassIndexOf: oop. cls asVoidPointer }]]. fmt := objectMemory formatOf: oop. ' format %lx' f: transcript printf: fmt. fmt > objectMemory lastPointerFormat ifTrue: [' nbytes %ld' f: transcript printf: (objectMemory numBytesOf: oop)] ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue: [| len | len := objectMemory lengthOf: oop. ' size %ld' f: transcript printf: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]]. objectMemory printHeaderTypeOf: oop on: transcript. self print: ' hash '; printHex: (objectMemory rawHashBitsOf: oop). self cr. (fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: ["This will answer false if splObj: ClassAlien is nilObject" (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue: [^' datasize %ld %s @ %p\n' f: transcript printf: {objectMemory sizeFieldOfAlien: oop. (self isIndirectAlien: oop) ifTrue: ['indirect'] ifFalse: [(self isPointerAlien: oop) ifTrue: ['pointer'] ifFalse: ['direct']]. self startOfAlienData: oop }]. (self is: oop KindOfClass: (self superclassOf: (objectMemory splObj: ClassString))) ifTrue: [^objectMemory printStringDataOf: oop on: transcript]. ^objectMemory printNonPointerDataOf: oop on: transcript]. startIP := fmt >= objectMemory firstCompiledMethodFormat ifTrue: [(self startPCOfMethod: oop) / objectMemory wordSize] ifFalse: [objectMemory numSlotsOf: oop]. 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 printOopShortInner: fieldOop]. self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > lastIndex ifTrue: [self print: '...'; cr]] ifTrue: [startIP := (self startPCOfMethod: oop) + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 256 ifTrue: [lastIndex := startIP + 256]. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: ['%11P ' f: transcript printf: (oop+BaseHeaderSize+index-1) asVoidPointer]. + byte := self cCoerceSimple: (objectMemory fetchByte: index - 1 ofObject: oop) to: #int. - byte := objectMemory fetchByte: index - 1 ofObject: oop. '%02x/%-3d%c' f: transcript printf: { byte. byte. column = 8 ifTrue: [Character cr] ifFalse: [Character space] }. (column := column + 1) > 8 ifTrue: [column := 1]]. (objectMemory lengthOf: oop) > lastIndex ifTrue: [self print: '...']. (column between: 2 and: 7) ifTrue: [self cr]]!
Item was changed: ----- Method: StackInterpreter>>openImageFileNamed: (in category 'simulation support') ----- openImageFileNamed: fileName "Attempt to open fileName or fileName, '.image'" <doNotGenerate> | f | f := [FileStream readOnlyFileNamed: fileName] on: FileDoesNotExistException do: [:ex| ((fileName endsWith: '.image') not + and: [FileDirectory default fileExists: (FileDirectory default fullNameFor: fileName), '.image']) ifFalse: - and: [FileDirectory default fileExists: fileName, '.image']) ifFalse: [ex pass]. FileStream readOnlyFileNamed: fileName, '.image']. ^f ifNil: [self error: 'no image found'. nil].!
Item was changed: ----- Method: StackInterpreter>>printCallStackOf: (in category 'debug printing') ----- printCallStackOf: aContextOrProcessOrFrame <public> "useful for VM debugging" | context | <inline: false> self cCode: nil inSmalltalk: [transcript ensureCr]. (stackPages couldBeFramePointer: aContextOrProcessOrFrame) ifTrue: + [^self printCallStackFP: aContextOrProcessOrFrame asCharPointer]. - [^self printCallStackFP: (self cCoerceSimple: aContextOrProcessOrFrame to: #'char *')]. aContextOrProcessOrFrame = self activeProcess ifTrue: [^self printCallStackOf: self headFramePointer]. (self couldBeProcess: aContextOrProcessOrFrame) ifTrue: [^self printCallStackOf: (objectMemory fetchPointer: SuspendedContextIndex ofObject: aContextOrProcessOrFrame)]. context := aContextOrProcessOrFrame. [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 changed: ----- Method: StackInterpreter>>printFrameThing:at: (in category 'debug printing') ----- printFrameThing: name at: address <inline: #always> <var: #name type: #'char *'> <var: #address type: #'char *'> + self printFrameThing: name at: address extraString: nil asCharPointer! - self printFrameThing: name at: address extraString: (self cCoerceSimple: nil to: #'char *')!
Item was changed: ----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') ----- printMethodCacheFor: thing <public> "useful for VM debugging" | n | n := 0. 0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do: [:i | | s c m p | s := methodCache at: i + MethodCacheSelector. c := methodCache at: i + MethodCacheClass. m := methodCache at: i + MethodCacheMethod. p := methodCache at: i + MethodCachePrimFunction. ((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing]]]]) and: [(objectMemory addressCouldBeOop: s) and: [c ~= 0 and: [(self addressCouldBeClassObj: c) or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue: [n := n + 1. self cCode: nil inSmalltalk: [self transcript ensureCr]. + '%ld %lx\n\t' f: transcript printf: { i. i }. - self printNum: i; space; printHexnp: i; cr; tab. (objectMemory isBytesNonImm: s) + ifTrue: ['%P %.*s\n' f: transcript printf: { s asVoidPointer. objectMemory numBytesOfBytes: s. (objectMemory firstIndexableField: s) asCharPointer }] - ifTrue: ['%p %.*s\n' f: transcript printf: { s. objectMemory numBytesOfBytes: s. objectMemory firstIndexableField: s }] ifFalse: [self shortPrintOop: s]. self tab. (self addressCouldBeClassObj: c) ifTrue: [self shortPrintOop: c] + ifFalse: [self printNum: c; space; printHexnp: c; space; shortPrintOop: (objectMemory classForClassTag: c)]. - ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)]. self tab; shortPrintOop: m; tab. self cCode: [p > 1024 ifTrue: [self printHexnp: p] ifFalse: [self printNum: p]] inSmalltalk: [p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]]. self cr]]. n > 1 ifTrue: [self printNum: n; cr]!
Item was changed: ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') ----- printOopShortInner: oop | classOop name nameLen | <var: #name type: #'char *'> <inline: false> (objectMemory isImmediate: oop) ifTrue: [(objectMemory isImmediateCharacter: oop) ifTrue: + [^'$%c(%lx)' f: transcript printf: { self cCoerceSimple: (objectMemory characterValueOf: oop) to: #int. + objectMemory characterValueOf: oop }]. - [^'$%c(%x)' f: transcript printf: { objectMemory characterValueOf: oop. objectMemory characterValueOf: oop }]. (objectMemory isIntegerObject: oop) ifTrue: [^'%ld(16r%lx)' f: transcript printf: { objectMemory integerValueOf: oop. objectMemory integerValueOf: oop }]. (objectMemory isImmediateFloat: oop) ifTrue: [^'%g(16r%lx)' f: transcript printf: {objectMemory dbgFloatValueOf: oop. oop}]. ^'unknown immediate %P' f: transcript printf: oop asVoidPointer]. (objectMemory addressCouldBeObj: oop) ifFalse: [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] ifFalse: [self whereIs: oop])]. (objectMemory isFreeObject: oop) ifTrue: [^self print: ' is a free chunk']. (objectMemory isForwarded: oop) ifTrue: [| target | target := objectMemory followForwarded: oop. ^' is a forwarder to %P' f: transcript printf: target asVoidPointer]. (self isFloatObject: oop) ifTrue: [^self printFloat: (objectMemory dbgFloatValueOf: oop)]. classOop := objectMemory fetchClassOfNonImm: oop. (objectMemory addressCouldBeObj: classOop) ifFalse: [^self print: 'a ??']. (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue: [^self printNameOfClass: oop count: 5]. oop = objectMemory nilObject ifTrue: [^self print: 'nil']. oop = objectMemory trueObject ifTrue: [^self print: 'true']. oop = objectMemory falseObject ifTrue: [^self print: 'false']. nameLen := self lengthOfNameOfClass: classOop. nameLen = 0 ifTrue: [^self print: 'a ??']. name := self nameOfClass: classOop. nameLen = 10 ifTrue: [(self strncmp: name _: 'ByteString' _: 10) = 0 "strncmp is weird" ifTrue: [^self printChar: $'; printStringOf: oop; printChar: $']. (self strncmp: name _: 'ByteSymbol' _: 10) = 0 "strncmp is weird" ifTrue: [self printChar: $#; printStringOf: oop. ^self]]. (nameLen = 9 and: [(self strncmp: name _: 'Character' _: 9) = 0]) ifTrue: [^self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop))]. 'a(n) %.*s' f: transcript printf: { nameLen. name }. "Try to spot association-like things; they're all subclasses of LookupKey" ((objectMemory isPointersNonImm: oop) and: [(objectMemory instanceSizeOf: classOop) = (ValueIndex + 1) and: [(objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]) ifTrue: [| classLookupKey | classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation). [classLookupKey = objectMemory nilObject ifTrue: [^self]. (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse: [classLookupKey := self superclassOf: classLookupKey]. (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue: [self space; printOopShortInner: (objectMemory fetchPointer: KeyIndex ofObject: oop); print: ' -> '; printHexnp: (objectMemory fetchPointer: ValueIndex ofObject: oop)]]!
Item was added: + ----- Method: String>>asCharPointer (in category '*VMMaker-interpreter simulation') ----- + asCharPointer + ^self!
Item was added: + ----- Method: UndefinedObject>>asCharPointer (in category '*VMMaker-interpreter simulator') ----- + asCharPointer + ^self!
Item was added: + ----- Method: UndefinedObject>>asVoidPointer (in category '*VMMaker-interpreter simulator') ----- + asVoidPointer + ^self!
vm-dev@lists.squeakfoundation.org