Vm-dev September 2021

vm-dev@lists.squeakfoundation.org

15 participants
137 discussions

[OpenSmalltalk/opensmalltalk-vm] 3fda28: Fix slip in non-Squeak code. [ci skip]
by Eliot Miranda 29 Sep '21

29 Sep '21

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 3fda28f4d0c220c930d5c6f3601e9fad36b81278 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/3fda28f4d0c220c930… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2021-09-28 (Tue, 28 Sep 2021) Changed paths: M platforms/iOS/vm/Common/Classes/sqSqueakMainApp.m Log Message: ----------- Fix slip in non-Squeak code. [ci skip]

1 0

VM Maker: VMMaker.oscog-eem.3077.mcz
by commits＠source.squeak.org 29 Sep '21

29 Sep '21

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3077.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3077 Author: eem Time: 28 September 2021, 4:51:48.850793 pm UUID: 8ad52133-62f2-4e1e-bf92-9b29ba104d62 Ancestors: VMMaker.oscog-eem.3076 StaclInterpreter: eliminate some warnings in the wake of the printing putsch. In particular do not map %p to PRIxSQPTR. =============== Diff against VMMaker.oscog-eem.3076 =============== Item was changed: ----- Method: CoInterpreter>>functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: (in category 'cog jit support') ----- functionPointerForCompiledMethod: methodObj primitiveIndex: primitiveIndex primitivePropertyFlagsInto: flagsPtr <api> <returnTypeC: 'void (*functionPointerForCompiledMethodprimitiveIndexprimitivePropertyFlagsInto(sqInt methodObj, sqInt primitiveIndex, sqInt *flagsPtr))(void)'> | functionPointer flags | <var: #functionPointer declareC: #'void (*functionPointer)(void)'> flagsPtr ifNotNil: [flagsPtr at: 0 put: (flags := self primitivePropertyFlags: primitiveIndex)]. functionPointer := self functionPointerFor: primitiveIndex inClass: nil. functionPointer == #primitiveCalloutToFFI ifTrue: [^self functionForPrimitiveCallout]. functionPointer == #primitiveExternalCall ifTrue: [| lit | lit := self attemptToLinkExternalPrimitive: methodObj. "N.B. We only support the FastCPrimitiveFlag on Spur because Spur will *not* run a GC to satisfy an allocation in a primitive. The V3 ObjectMemory will and hence the depth of stack needed in a V3 primitive is probably too large to safely execute on a stack page." objectMemory hasSpurMemoryManagerAPI ifTrue: [| metadataFlags shiftedMetadataFlags | metadataFlags := objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit. (objectMemory isIntegerObject: metadataFlags) ifTrue: [shiftedMetadataFlags := ((objectMemory integerValueOf: metadataFlags) bitAnd: SpurPrimitiveFlagsMask) bitShift: PrimitiveMetadataFlagsShift. shiftedMetadataFlags > 0 ifTrue: ["Intentionally clear all other flags if there are Spur metadata flags..." flags := shiftedMetadataFlags]]]. (self object: (objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit) + equalsString: 'primitiveProfileSemaphore') ifTrue: - equalsString: #primitiveProfileSemaphore) ifTrue: [flags := flags bitOr: PrimCallMayEndureCodeCompaction]. profileSemaphore ~= objectMemory nilObject ifTrue: [flags := flags bitOr: PrimCallCollectsProfileSamples]. flagsPtr at: 0 put: flags. ^self functionForPrimitiveExternalCall: methodObj]. ^functionPointer! Item was changed: ----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') ----- printMethodCacheFor: thing <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" | 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: [] inSmalltalk: [self transcript ensureCr]. self printNum: i; space; printHexnp: i; cr; tab. (objectMemory isBytesNonImm: s) + ifTrue: ['%p %.*s\n' f: transcript printf: { s. (objectMemory numBytesOfBytes: s) signedIntFromLong. objectMemory firstIndexableField: s }] - 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)]. 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>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') ----- readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset "Read an image from the given file stream, allocating an amount of memory to its object heap. V3: desiredHeapSize is the total size of the heap. Fail if the image has an unknown format or requires more than the specified amount of memory. Spur: desiredHeapSize is ignored; this routine will attempt to provide at least extraVMMemory's ammount of free space after the image is loaded, taking any free space in the image into account. extraVMMemory is stored in the image header and is accessible as vmParameterAt: 23. If extraVMMemory is 0, the value defaults to the default grow headroom. Fail if the image has an unknown format or if sufficient memory cannot be allocated. 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." | swapBytes headerStart headerSize headerFlags dataSize bytesRead bytesToShift heapSize oldBaseAddr minimumMemory allocationReserve cogCodeBase firstSegSize hdrNumStackPages hdrEdenBytes hdrCogCodeSize hdrMaxExtSemTabSize | + <var: 'f' type: #sqImageFile> + <var: 'heapSize' type: #usqInt> + <var: 'dataSize' type: #'size_t'> + <var: 'minimumMemory' type: #usqInt> + <var: 'desiredHeapSize' type: #usqInt> + <var: 'allocationReserve' type: #usqInt> + <var: 'headerStart' type: #squeakFileOffsetType> + <var: 'imageOffset' type: #squeakFileOffsetType> - <var: #f type: #sqImageFile> - <var: #heapSize type: #usqInt> - <var: #dataSize type: #'size_t'> - <var: #minimumMemory type: #usqInt> - <var: #desiredHeapSize type: #usqInt> - <var: #allocationReserve type: #usqInt> - <var: #headerStart type: #squeakFileOffsetType> - <var: #imageOffset type: #squeakFileOffsetType> transcript := #stdout. "stdout is not available at compile time. this is the earliest available point." metaclassNumSlots := 6. "guess Metaclass instSize" classNameIndex := 6. "guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1" swapBytes := self checkImageVersionFrom: f startingAt: imageOffset. headerStart := (self sqImageFilePosition: f) - 4. "record header start position" headerSize := self getWord32FromFile: 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 getWord32FromFile: f swap: swapBytes. "N.B. ignored in V3." 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: [cogit defaultCogCodeSize] ifFalse: [desiredCogCodeSize := hdrCogCodeSize]]. "set for vmParameter 47" cogCodeSize > cogit maxCogCodeSize ifTrue: [cogCodeSize := cogit maxCogCodeSize]. hdrEdenBytes := self getWord32FromFile: 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]. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. Preserve it to be polite to other VMs." the2ndUnknownShort := self getShortFromFile: f swap: swapBytes. firstSegSize := self getLongFromFile: f swap: swapBytes. objectMemory firstSegmentSize: firstSegSize. "compare memory requirements with availability" allocationReserve := self interpreterAllocationReserveBytes. minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed" + dataSize + objectMemory newSpaceBytes + allocationReserve. "Compute how much space is needed for the initial heap allocation. no need to include the stackZone; this is alloca'ed. no need to include the JIT code zone size; this is allocated separately." objectMemory hasSpurMemoryManagerAPI ifTrue: [| freeOldSpaceInImage headroom | freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes. headroom := objectMemory initialHeadroom: extraVMMemory givenFreeOldSpaceInImage: freeOldSpaceInImage. heapSize := objectMemory roundUpHeapSize: dataSize + headroom + objectMemory newSpaceBytes + (headroom > allocationReserve ifTrue: [0] ifFalse: [allocationReserve])] ifFalse: [heapSize := desiredHeapSize + objectMemory newSpaceBytes + (desiredHeapSize - dataSize > allocationReserve ifTrue: [0] ifFalse: [allocationReserve]). heapSize < minimumMemory ifTrue: [self insufficientMemorySpecifiedError]]. "allocateJITMemory will assign the actual size allocated, which is rounded up to a page boundary." + cogCodeBase := (self allocateJITMemory: (self addressOf: cogCodeSize)) asInteger. - cogCodeBase := self allocateJITMemory: (self addressOf: cogCodeSize). "allocate a contiguous block of memory for the Squeak heap and ancilliary data structures" (self allocateMemory: heapSize minimum: minimumMemory imageFile: f headerSize: headerSize) asUnsignedInteger ifNil: [self insufficientMemoryAvailableError] ifNotNil: [:mem| "cannot clash with the variable memory still in use in NewCoObjectMemory and superclasses" objectMemory setHeapBase: (heapBase := mem) memoryLimit: mem + heapSize endOfMemory: mem + 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 := objectMemory readHeapFromImageFile: f dataBytes: dataSize. bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. self ensureImageFormatIsUpToDate: swapBytes. "compute difference between old and new memory base addresses" bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. self initializeInterpreter: bytesToShift. "adjusts all oops to new location" cogit initializeCodeZoneFrom: cogCodeBase upTo: cogCodeBase + cogCodeSize. ^dataSize! Item was added: + ----- Method: CogVMSimulator>>headFramePointer (in category 'accessing') ----- + headFramePointer + ^localFP ifNil: [framePointer]! Item was changed: ----- Method: CogVMSimulator>>printCallStack (in category 'debug printing') ----- printCallStack + "This is almost the same as StackInterpreter's implementation but in simulation this will print from the machince code head frame." - <inline: false> cogit headFramePointer ifNil: [self printCallStackOf: (objectMemory fetchPointer: SuspendedContextIndex ofObject: self activeProcess)] ifNotNil: [:fp| self printCallStackFP: fp]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveListBuiltinModule (in category 'plugin primitives') ----- primitiveListBuiltinModule "Primitive. Return the n-th builtin module name." | index | + <var: 'moduleName' type: #'char *'> self methodArgumentCount = 1 ifFalse: [^self primitiveFail]. index := self stackIntegerValue: 0. (self failed or: [index <= 0]) ifTrue: [^self primitiveFail]. (self ioListBuiltinModule: index) ifNil: [self methodReturnValue: objectMemory nilObject] ifNotNil: [:moduleName| self methodReturnString: moduleName]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveListExternalModule (in category 'plugin primitives') ----- primitiveListExternalModule "Primitive. Answer the n-th loaded external module name." | index | + <var: 'moduleName' type: #'char *'> self methodArgumentCount = 1 ifFalse: [^self primitiveFail]. index := self stackIntegerValue: 0. (self failed or: [index <= 0]) ifTrue: [^self primitiveFail]. (self ioListLoadedModule: index) ifNil: [self methodReturnValue: objectMemory nilObject] ifNotNil: [:moduleName| self methodReturnString: moduleName]! Item was changed: ----- Method: PrintfNumberFormatDescriptor>>transformForVMMaker (in category '*VMMaker-C code generation') ----- transformForVMMaker ('duxX' includes: operator) ifTrue: [^'%" PRI', (String with: operator), 'SQINT "']. - ('pP' includes: operator) ifTrue: - [^'%" PRI', (String with: (operator = $p ifTrue: [$x] ifFalse: [$X])), 'SQPTR "']. ^super transformForVMMaker! Item was added: + ----- Method: StackInterpreter>>headFramePointer (in category 'accessing') ----- + headFramePointer + "Answer the framePointer for the active frame. In the production VM all we can + get our hands on is framePointer. localFP is a register variable inside interpret. + But in the simulator we have access to localFP and so this mehtod is reimplemented there-in" + <inline: #always> + ^framePointer asInteger! Item was changed: ----- Method: StackInterpreter>>object:equalsString: (in category 'utilities') ----- object: anOop equalsString: aCString + <var: 'aCString' type: #'char *'> + <inline: true> ^self object: anOop equalsString: aCString ofSize: (self strlen: aCString)! Item was changed: ----- Method: StackInterpreter>>object:equalsString:ofSize: (in category 'utilities') ----- object: anOop equalsString: aCString ofSize: aCStringStrlen + <var: 'aCString' type: #'char *'> - | size | ^(objectMemory isBytes: anOop) + and: [(objectMemory numBytesOfBytes: anOop) = aCStringStrlen - and: [(size := objectMemory numBytesOfBytes: anOop) = aCStringStrlen and: [(self strncmp: aCString _: (objectMemory firstIndexableField: anOop) _: aCStringStrlen) = 0]]! Item was changed: ----- Method: StackInterpreter>>printAllStacks (in category 'debug printing') ----- printAllStacks "Print all the stacks of all running processes, including those that are currently suspended." <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" | proc semaphoreClass mutexClass schedLists p processList | <inline: false> proc := self activeProcess. self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5; space; printHex: proc. self print: ' priority '; printNum: (self quickFetchInteger: PriorityIndex ofObject: proc); cr. + self printCallStack. "first the current activation" - self printCallStackFP: framePointer. "first the current activation" schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer. "then the runnable processes" p := highestRunnableProcessPriority = 0 ifTrue: [objectMemory numSlotsOf: schedLists] ifFalse: [highestRunnableProcessPriority]. p - 1 to: 0 by: -1 do: [:pri| processList := objectMemory fetchPointer: pri ofObject: schedLists. (self isEmptyList: processList) ifFalse: [self cr; print: 'processes at priority '; printNum: pri + 1. self printProcsOnList: processList]]. self cr; print: 'suspended processes'. semaphoreClass := objectMemory classSemaphore. mutexClass := objectMemory classMutex. objectMemory hasSpurMemoryManagerAPI ifTrue: [semaphoreClass := objectMemory compactIndexOfClass: semaphoreClass. mutexClass := objectMemory compactIndexOfClass: mutexClass. objectMemory allHeapEntitiesDo: [:obj| | classIdx | classIdx := objectMemory classIndexOf: obj. (classIdx = semaphoreClass or: [classIdx = mutexClass]) ifTrue: [self printProcsOnList: obj]]] ifFalse: [objectMemory allObjectsDoSafely: [:obj| | classObj | classObj := objectMemory fetchClassOfNonImm: obj. (classObj = semaphoreClass or: [classObj = mutexClass]) ifTrue: [self printProcsOnList: obj]]]! Item was changed: ----- Method: StackInterpreter>>printCallStackOf: (in category 'debug printing') ----- printCallStackOf: aContextOrProcessOrFrame <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" | context | <inline: false> (stackPages couldBeFramePointer: aContextOrProcessOrFrame) ifTrue: [^self printCallStackFP: (self cCoerceSimple: aContextOrProcessOrFrame to: #'char *')]. aContextOrProcessOrFrame = self activeProcess ifTrue: + [^self printCallStackOf: self headFramePointer]. - [^self printCallStackOf: (self cCode: [framePointer asInteger] inSmalltalk: [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>>printStackCallStackOf: (in category 'debug printing') ----- printStackCallStackOf: aContextOrProcessOrFrame <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" | theFP context | <var: #theFP type: #'char *'> (self cCode: [false] "In the stack simulator, frame pointers are negative which upsets addressCouldBeObj:" inSmalltalk: [stackPages couldBeFramePointer: aContextOrProcessOrFrame]) ifFalse: [(objectMemory addressCouldBeObj: aContextOrProcessOrFrame) ifTrue: [((objectMemory isContext: aContextOrProcessOrFrame) and: [self checkIsStillMarriedContext: aContextOrProcessOrFrame currentFP: nil]) ifTrue: [^self printStackCallStackOf: (self frameOfMarriedContext: aContextOrProcessOrFrame) asInteger]. aContextOrProcessOrFrame = self activeProcess ifTrue: + [^self printStackCallStackOf: self headFramePointer]. - [^self printStackCallStackOf: (self cCode: [framePointer asInteger] inSmalltalk: [self headFramePointer])]. (self couldBeProcess: aContextOrProcessOrFrame) ifTrue: [^self printCallStackOf: (objectMemory fetchPointer: SuspendedContextIndex ofObject: aContextOrProcessOrFrame)]. ^nil]]. theFP := aContextOrProcessOrFrame asVoidPointer. [context := self shortReversePrintFrameAndCallers: theFP. ((self isMarriedOrWidowedContext: context) and: [theFP := self frameOfMarriedContext: context. self checkIsStillMarriedContext: context currentFP: theFP]) ifFalse: [^nil]] repeat! Item was changed: ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') ----- readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset "Read an image from the given file stream, allocating an amount of memory to its object heap. V3: desiredHeapSize is the total size of the heap. Fail if the image has an unknown format or requires more than the specified amount of memory. Spur: desiredHeapSize is ignored; this routine will attempt to provide at least extraVMMemory's ammount of free space after the image is loaded, taking any free space in teh image into account. extraVMMemory is stored in the image header and is accessible as vmParameterAt: 23. If extraVMMemory is 0, the value defaults to the default grow headroom. Fail if the image has an unknown format or if sufficient memory cannot be allocated. 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." | headerStart headerSize headerFlags dataSize oldBaseAddr swapBytes minimumMemory bytesRead bytesToShift heapSize firstSegSize hdrEdenBytes hdrMaxExtSemTabSize hdrNumStackPages allocationReserve | + <var: 'f' type: #sqImageFile> + <var: 'heapSize' type: #usqInt> + <var: 'dataSize' type: #'size_t'> + <var: 'minimumMemory' type: #usqInt> + <var: 'desiredHeapSize' type: #usqInt> + <var: 'allocationReserve' type: #usqInt> + <var: 'headerStart' type: #squeakFileOffsetType> + <var: 'imageOffset' type: #squeakFileOffsetType> - <var: #f type: #sqImageFile> - <var: #heapSize type: #usqInt> - <var: #dataSize type: #'size_t'> - <var: #minimumMemory type: #usqInt> - <var: #desiredHeapSize type: #usqInt> - <var: #allocationReserve type: #usqInt> - <var: #headerStart type: #squeakFileOffsetType> - <var: #imageOffset type: #squeakFileOffsetType> transcript := #stdout. "stdout is not available at compile time. this is the earliest available point." metaclassNumSlots := 6. "guess Metaclass instSize" classNameIndex := 6. "guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1" swapBytes := self checkImageVersionFrom: f startingAt: imageOffset. headerStart := (self sqImageFilePosition: f) - 4. "record header start position" headerSize := self getWord32FromFile: 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 getWord32FromFile: f swap: swapBytes. 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. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. It is used for the cog code size in Cog. Preserve it to be polite to other VMs." theUnknownShort := self getShortFromFile: f swap: swapBytes. hdrEdenBytes := self getWord32FromFile: 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]. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. Preserve it to be polite to other VMs." the2ndUnknownShort := self getShortFromFile: f swap: swapBytes. firstSegSize := self getLongFromFile: f swap: swapBytes. objectMemory firstSegmentSize: firstSegSize. "compare memory requirements with availability" allocationReserve := self interpreterAllocationReserveBytes. minimumMemory := dataSize + objectMemory newSpaceBytes + allocationReserve. objectMemory hasSpurMemoryManagerAPI ifTrue: [| freeOldSpaceInImage headroom | freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes. headroom := objectMemory initialHeadroom: extraVMMemory givenFreeOldSpaceInImage: freeOldSpaceInImage. heapSize := objectMemory roundUpHeapSize: dataSize + headroom + objectMemory newSpaceBytes + (headroom > allocationReserve ifTrue: [0] ifFalse: [allocationReserve])] ifFalse: [heapSize := desiredHeapSize + objectMemory newSpaceBytes + (desiredHeapSize - dataSize > allocationReserve ifTrue: [0] ifFalse: [allocationReserve]). heapSize < minimumMemory ifTrue: [self insufficientMemorySpecifiedError]]. "allocate a contiguous block of memory for the Squeak heap" (self allocateMemory: heapSize minimum: minimumMemory imageFile: f headerSize: headerSize) asUnsignedInteger ifNil: [self insufficientMemoryAvailableError] ifNotNil: [:mem| objectMemory setHeapBase: mem memoryLimit: mem + heapSize endOfMemory: mem + 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 := objectMemory readHeapFromImageFile: f dataBytes: dataSize. bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. self ensureImageFormatIsUpToDate: swapBytes. "compute difference between old and new memory base addresses" bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. self initializeInterpreter: bytesToShift. "adjusts all oops to new location" ^dataSize! Item was added: + ----- Method: StackInterpreterSimulator>>headFramePointer (in category 'accessing') ----- + headFramePointer + ^localFP ifNil: [framePointer]!

1 0

VM Maker: VMMakerUI-eem.47.mcz
by commits＠source.squeak.org 29 Sep '21

29 Sep '21

Eliot Miranda uploaded a new version of VMMakerUI to project VM Maker: http://source.squeak.org/VMMaker/VMMakerUI-eem.47.mcz ==================== Summary ==================== Name: VMMakerUI-eem.47 Author: eem Time: 28 September 2021, 4:49:27.614785 pm UUID: e9caf27f-6d3d-44c3-967f-142f9426d89e Ancestors: VMMakerUI-eem.46 headFramePointer now belongs in VMMaker proper. =============== Diff against VMMakerUI-eem.46 =============== Item was removed: - ----- Method: CogVMSimulator>>headFramePointer (in category '*VMMakerUI-user interface') ----- - headFramePointer - ^localFP ifNil: [framePointer]! Item was removed: - ----- Method: StackInterpreter>>headFramePointer (in category '*VMMakerUI-user interface') ----- - headFramePointer - "Answer the framePointer for the active frame. In the production VM all we can - get our hands on is framePointer. localFP is a register variable inside interpret. - But in the simulator we have access to localFP and so this mehtod is reimplemented there-in" - <inline: #always> - ^framePointer! Item was removed: - ----- Method: StackInterpreterSimulator>>headFramePointer (in category '*VMMakerUI-user interface') ----- - headFramePointer - ^localFP ifNil: [framePointer]!

1 0

VM Maker: VMMaker.oscog-eem.3076.mcz
by commits＠source.squeak.org 28 Sep '21

28 Sep '21

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3076.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3076 Author: eem Time: 28 September 2021, 10:53:41.911915 am UUID: ebca036d-ae29-45f9-b768-65766ee8164e Ancestors: VMMaker.oscog-eem.3075 Add primitiveFailFor:withSecondary: to allow the ThreadedFFIPlugin to fail with the new PrimErrFFIMarshallingError and its own specific marshalling error code as a parameter. StackInterpreter: make sure primitiveCallout is loaded only once from SqueakFFIPrims. C initializer semantics may have meant it was being reloaded every time. =============== Diff against VMMaker.oscog-eem.3075 =============== Item was changed: Object subclass: #InterpreterProxy + instanceVariableNames: 'primFailCode remapBuffer stack method argumentCount bb thisSessionID secondaryErrorCode exceptionPC' - instanceVariableNames: 'primFailCode remapBuffer stack method argumentCount bb thisSessionID osErrorCode exceptionPC' classVariableNames: '' poolDictionaries: 'VMBasicConstants' category: 'VMMaker-InterpreterSimulation'! !InterpreterProxy commentStamp: 'eem 8/24/2018 15:43' prior: 0! This class should provide the definition of what interpreter support plugins need and can have access to. Note that the proxy related files platforms - Cross - vm - sqVirtualMachine.[ch] are kept under the git tree at http://www.github.com/opensmalltalk/vm. The main use of the class is to support the vm simulator and the RSqueak VM, which implements as many primitives as possible in Smalltalk.! Item was added: + ----- Method: InterpreterProxy>>primitiveFailFor:withSecondary: (in category 'other') ----- + primitiveFailFor: reasonCode withSecondary: extraErrorCode + <var: 'extraErrorCode' type: #sqLong> + <option: #(atLeastVMProxyMajor:minor: 1 14)> + "Set primFailCode primitive failure and associated secondaryErrorCode. + Primitive 255 is called to indicate that we are currently simulating a primitive that should fail and the VM should handle that case appropriately (if supported by the VM)." + <primitive: 255> + secondaryErrorCode := extraErrorCode. + ^primFailCode := reasonCode! Item was changed: ----- Method: InterpreterProxy>>primitiveFailForFFIException:at: (in category 'other') ----- primitiveFailForFFIException: exceptionCode at: pc <var: 'exceptionCode' type: #usqLong> <var: 'pc' type: #usqInt> <option: #(atLeastVMProxyMajor:minor: 1 14)> "Set PrimErrFFIException primitive failure and associated exceptionCode (a.k.a. osErrorCode) and exceptionPC." <primitive: 255> + secondaryErrorCode := exceptionCode. - osErrorCode := exceptionCode. exceptionPC := pc. ^primFailCode := PrimErrFFIException! Item was changed: ----- Method: InterpreterProxy>>primitiveFailForOSError: (in category 'other') ----- + primitiveFailForOSError: osErrorCode + <var: 'osErrorCode' type: #sqLong> - primitiveFailForOSError: osError - <var: 'osError' type: #sqLong> <option: #(atLeastVMProxyMajor:minor: 1 14)> + "Set PrimErrOSError primitive failure and associated secondaryErrorCode. - "Set PrimErrOSError primitive failure and associated osErrorCode. Primitive 255 is called to indicate that we are currently simulating a primitive that should fail and the VM should handle that case appropriately (if supported by the VM)." <primitive: 255> + secondaryErrorCode := osErrorCode. - osErrorCode := osError. ^primFailCode := PrimErrOSError! Item was added: + ----- Method: NewObjectMemory>>primitiveFailFor:withSecondary: (in category 'as yet unclassified') ----- + primitiveFailFor: reasonCode withSecondary: extraErrorCode + "hack around the CoInterpreter/ObjectMemory split refactoring" + <doNotGenerate> + ^coInterpreter primitiveFailFor: reasonCode withSecondary: extraErrorCode! Item was added: + ----- Method: SpurMemoryManager>>primitiveFailFor:withSecondary: (in category 'simulation only') ----- + primitiveFailFor: reasonCode withSecondary: extraErrorCode + "hack around the CoInterpreter/ObjectMemory split refactoring" + <doNotGenerate> + ^coInterpreter primitiveFailFor: reasonCode withSecondary: extraErrorCode! Item was changed: InterpreterPrimitives subclass: #StackInterpreter (excessive size, no diff calculated) Item was added: + ----- Method: StackInterpreter>>cloneErrorObj: (in category 'message sending') ----- + cloneErrorObj: errObj + "If errObj is a pointer object with at least two slots, then answer a clone + of the error object with the second slot set to the value of secondaryErrorCode, + and if an PrimErrFFIException, then the third slow with the exceptionPC." + | numSlots clone | + <inline: true> + numSlots := objectMemory numSlotsOf: errObj. + clone := objectMemory hasSpurMemoryManagerAPI + ifTrue: [objectMemory + eeInstantiateAnySmallClassIndex: (objectMemory classIndexOf: errObj) + format: objectMemory nonIndexablePointerFormat + numSlots: numSlots] + ifFalse: [objectMemory + eeInstantiateSmallClass: (objectMemory fetchClassOfNonImm: errObj) + numSlots: numSlots]. + 0 to: numSlots - 1 do: + [:i| objectMemory + storePointerUnchecked: i + ofObject: clone + withValue: (objectMemory fetchPointer: i ofObject: errObj)]. + (numSlots > 2 + and: [primFailCode = PrimErrFFIException]) + ifTrue: + [objectMemory + storePointerUnchecked: 1 + ofObject: clone + withValue: (self positive64BitIntegerFor: (self cCoerceSimple: secondaryErrorCode to: #usqLong)); + storePointerUnchecked: 2 + ofObject: clone + withValue: (self positiveMachineIntegerFor: exceptionPC)] + ifFalse: + [objectMemory + storePointerUnchecked: 1 + ofObject: clone + withValue: (self signed64BitIntegerFor: secondaryErrorCode)]. + ^clone! Item was removed: - ----- Method: StackInterpreter>>cloneOSErrorObj:numSlots: (in category 'message sending') ----- - cloneOSErrorObj: errObj numSlots: numSlots - "If errObj is a pointer object with at least two slots, then answer a clone - of the error object with the second slot set to the value of osErrorCode, - and if an PrimErrFFIException, then the third slow with the exceptionPC." - | clone | - <inline: true> - clone := objectMemory hasSpurMemoryManagerAPI - ifTrue: [objectMemory - eeInstantiateAnySmallClassIndex: (objectMemory classIndexOf: errObj) - format: objectMemory nonIndexablePointerFormat - numSlots: numSlots] - ifFalse: [objectMemory - eeInstantiateSmallClass: (objectMemory fetchClassOfNonImm: errObj) - numSlots: numSlots]. - 0 to: numSlots - 1 do: - [:i| objectMemory - storePointerUnchecked: i - ofObject: clone - withValue: (objectMemory fetchPointer: i ofObject: errObj)]. - (numSlots > 2 - and: [primFailCode = PrimErrFFIException]) - ifTrue: - [objectMemory - storePointerUnchecked: 1 - ofObject: clone - withValue: (self positive64BitIntegerFor: (self cCoerceSimple: osErrorCode to: #usqLong)); - storePointerUnchecked: 2 - ofObject: clone - withValue: (self positiveMachineIntegerFor: exceptionPC)] - ifFalse: - [objectMemory - storePointerUnchecked: 1 - ofObject: clone - withValue: (self signed64BitIntegerFor: osErrorCode)]. - ^clone! Item was changed: ----- Method: StackInterpreter>>functionForPrimitiveCallout (in category 'plugin primitive support') ----- functionForPrimitiveCallout "Answer the function primitiveCallout from the FFI plugin or nil if it can't be found. Cache it for performance. We use this circumlocution so that Squeak can be deployed without the FFI plugin for security reasons." <returnTypeC: 'void (*functionForPrimitiveCallout())(void)'> + <inline: true> + primitiveCalloutPointer asInteger = -1 ifTrue: + [primitiveCalloutPointer := self ioLoadFunction: 'primitiveCallout' From: 'SqueakFFIPrims']. + ^self cCoerceSimple: primitiveCalloutPointer to: #'void (*)(void)'! - | function | - <var: #function declareC: 'static void *function = (void *)-1'> - self cCode: '' inSmalltalk: [function := -1]. - function asInteger = -1 ifTrue: - [function := self ioLoadFunction: 'primitiveCallout' From: 'SqueakFFIPrims']. - ^self cCoerceSimple: function to: #'void (*)(void)'! Item was changed: ----- Method: StackInterpreter>>getErrorObjectFromPrimFailCode (in category 'message sending') ----- getErrorObjectFromPrimFailCode "Answer the errorCode object to supply to a failing primitive method that accepts one. If there is a primitive error table and the primFailCode is a valid index there-in answer the corresponding entry in the table, otherwise simply answer the code as an integer." + | table errObj | - | table errObj numSlots | primFailCode > 0 ifTrue: [table := objectMemory splObj: PrimErrTableIndex. primFailCode <= (objectMemory numSlotsOf: table) ifTrue: [errObj := objectMemory followField: primFailCode - 1 ofObject: table. + "If there's a clonable object in the table at that index, + answer a clone of the error object with the second slot set to the value of secondaryErrorCode." + (objectMemory formatOf: errObj) = objectMemory nonIndexablePointerFormat ifTrue: + [errObj := self cloneErrorObj: errObj]. - "If this is a PrimErrOSError/PrimErrFFIException and there's a clonable object in the table at that index, - answer a clone of the error object with the second slot set to the value of osErrorCode." - ((primFailCode = PrimErrOSError or: [primFailCode = PrimErrFFIException]) - and: [(objectMemory formatOf: errObj) = objectMemory nonIndexablePointerFormat - and: [(numSlots := objectMemory numSlotsOf: errObj) >= 2]]) ifTrue: - [errObj := self cloneOSErrorObj: errObj numSlots: numSlots]. ^errObj]]. ^objectMemory integerObjectOf: primFailCode! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiFail: (in category 'callout support') ----- ffiFail: reason <inline: false> "Map the FFI error code into a primitive error code. If reason is negative it encodes one of the standard PrimErr... codes, negated to distinguish it from the FFIError codes. If it is an FFIError... code then add the size of the primitive error table + 2 to disambiguate it from the PrimErr... codes. For historic reasons the FFIError codes range from -1 on up hence adding size + 2 maps them to size of table + 1 on up. This OFFSET IS undone by ExternalFunction class>>externalCallFailedWith:. + Thus we can communicate back both PrimErr.. and FFIError codes. Complex but necessary. + + If a clonable PrimErrFFIMarshallingError is present in the error table then use the new scheme." - Thus we can communicate back both PrimErr.. and FFIError codes. Complex but necessary." ffiLastError := reason. + reason >= FFINoCalloutAvailable ifTrue: + [| errorTable numErrorTableSlots | + errorTable := interpreterProxy primitiveErrorTable. + numErrorTableSlots := interpreterProxy slotSizeOf: errorTable. + (numErrorTableSlots >= PrimErrFFIMarshallingError + and: [interpreterProxy isPointers: errorTable]) ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrFFIMarshallingError withSecondary: reason]. + ^interpreterProxy primitiveFailFor: reason + 2 + numErrorTableSlots]. + ^interpreterProxy primitiveFailFor: reason negated! - ^interpreterProxy primitiveFailFor: - (reason >= FFINoCalloutAvailable - ifTrue: [reason + 2 + (interpreterProxy slotSizeOf: interpreterProxy primitiveErrorTable)] - ifFalse: [reason negated])! Item was changed: SharedPool subclass: #VMBasicConstants instanceVariableNames: '' + classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMForFFICall DisownVMForThreading DoAssertionChecks DoExpensiveAssertionChecks FastCPrimitiveAlignForFloatsFlag FastCPrimitiveFlag GCCheckFreeSpace GCCheckImageSegment GCCheckPrimCall GCCheckShorten GCModeBecome GCModeFull GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrFFIException PrimErrFFIMarshallingError PrimErrGenericFailure PrimErrInappropriate PrimErrInternalError PrimErrLimitExceeded PrimErrNamedInternal PrimErrNeedCompaction PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrOperationFailed PrimErrUninitialized PrimEr rUnsupported PrimErrWritePastObject PrimNoErr PrimNumberHandlerMarker PrimNumberNoContextSwitchMarker PrimNumberUnwindMarker SPURVM STACKVM SistaVM TempVectReadBarrier VMBIGENDIAN' - classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMForFFICall DisownVMForThreading DoAssertionChecks DoExpensiveAssertionChecks FastCPrimitiveAlignForFloatsFlag FastCPrimitiveFlag GCCheckFreeSpace GCCheckImageSegment GCCheckPrimCall GCCheckShorten GCModeBecome GCModeFull GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrFFIException PrimErrGenericFailure PrimErrInappropriate PrimErrInternalError PrimErrLimitExceeded PrimErrNamedInternal PrimErrNeedCompaction PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrOperationFailed PrimErrUninitialized PrimErrUnsupported PrimErrWritePa stObject PrimNoErr PrimNumberHandlerMarker PrimNumberNoContextSwitchMarker PrimNumberUnwindMarker SPURVM STACKVM SistaVM TempVectReadBarrier VMBIGENDIAN' poolDictionaries: '' category: 'VMMaker-Interpreter'! !VMBasicConstants commentStamp: '<historical>' prior: 0! I am a shared pool for basic constants upon which the VM as a whole depends. self ensureClassPool. self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool. self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool (ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do: [:k| self classPool declare: k from: ObjectMemory classPool]! Item was changed: ----- Method: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') ----- initializePrimitiveErrorCodes "Define the VM's primitive error codes. N.B. these are replicated in platforms/Cross/vm/sqVirtualMachine.h." "VMClass initializePrimitiveErrorCodes" | pet | PrimErrTableIndex := 51. "Zero-relative" "See SmalltalkImage>>recreateSpecialObjectsArray for the table definition. If the table exists and is large enough the corresponding entry is returned as the primitive error, otherwise the error is answered numerically." pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()]. pet isArray ifFalse: [pet := #()]. PrimNoErr := 0. "for helper methods that need to answer success or an error code." PrimErrGenericFailure := pet indexOf: nil ifAbsent: 1. PrimErrBadReceiver := pet indexOf: #'bad receiver' ifAbsent: 2. PrimErrBadArgument := pet indexOf: #'bad argument' ifAbsent: 3. PrimErrBadIndex := pet indexOf: #'bad index' ifAbsent: 4. PrimErrBadNumArgs := pet indexOf: #'bad number of arguments' ifAbsent: 5. PrimErrInappropriate := pet indexOf: #'inappropriate operation' ifAbsent: 6. PrimErrUnsupported := pet indexOf: #'unsupported operation' ifAbsent: 7. PrimErrNoModification := pet indexOf: #'no modification' ifAbsent: 8. PrimErrNoMemory := pet indexOf: #'insufficient object memory' ifAbsent: 9. PrimErrNoCMemory := pet indexOf: #'insufficient C memory' ifAbsent: 10. PrimErrNotFound := pet indexOf: #'not found' ifAbsent: 11. PrimErrBadMethod := pet indexOf: #'bad method' ifAbsent: 12. PrimErrNamedInternal := pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13. PrimErrObjectMayMove := pet indexOf: #'object may move' ifAbsent: 14. PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15. PrimErrObjectIsPinned := pet indexOf: #'object is pinned' ifAbsent: 16. PrimErrWritePastObject := pet indexOf: #'primitive write beyond end of object' ifAbsent: 17. PrimErrObjectMoved := pet indexOf: #'object moved' ifAbsent: 18. PrimErrObjectNotPinned := pet indexOf: #'object not pinned' ifAbsent: 19. PrimErrCallbackError := pet indexOf: #'error in callback' ifAbsent: 20. PrimErrOSError := pet indexOf: #'operating system error' ifAbsent: 21. PrimErrFFIException := pet indexOf: #'ffi call exception' ifAbsent: 22. PrimErrNeedCompaction := pet indexOf: #'heap compaction needed' ifAbsent: 23. "N.B. This is currently an internal error in Spur image segment saving." PrimErrOperationFailed := pet indexOf: #'operation failed' ifAbsent: 24. PrimErrInternalError := pet indexOf: #'internal error' ifAbsent: 25. + PrimErrUninitialized := pet indexOf: #'uninitialized' ifAbsent: 26. + PrimErrFFIMarshallingError := pet indexOf: #'ffi marshalling error' ifAbsent: 27! - PrimErrUninitialized := pet indexOf: #'uninitialized' ifAbsent: 26!

1 0

VM Maker: VMMakerUI-eem.46.mcz
by commits＠source.squeak.org 28 Sep '21

28 Sep '21

Eliot Miranda uploaded a new version of VMMakerUI to project VM Maker: http://source.squeak.org/VMMaker/VMMakerUI-eem.46.mcz ==================== Summary ==================== Name: VMMakerUI-eem.46 Author: eem Time: 28 September 2021, 10:50:26.633698 am UUID: 8dd1e2dd-f86e-4a9a-9c9f-d4594f9e8fd1 Ancestors: VMMakerUI-eem.45 Changes to accompany VMMaker.oscog-eem.3075 =============== Diff against VMMakerUI-eem.45 =============== Item was changed: ----- Method: CogVMSimulator>>evaluatePrinter:on: (in category '*VMMakerUI-user interface') ----- evaluatePrinter: aBlock on: aStream "Hack to redirect printing to aStream, here to avoid reimplementing all the printing machinery." + | savedTranscript | - | savedTraceOn savedTranscript | - savedTraceOn := traceOn. savedTranscript := transcript. - traceOn := true. transcript := aStream. ^aBlock ensure: + [transcript := savedTranscript]! - [traceOn := savedTraceOn. transcript := savedTranscript]! Item was removed: - ----- Method: NewObjectMemory>>printHeaderTypeOf:on: (in category '*VMMakerUI-debug printing') ----- - printHeaderTypeOf: obj on: aStream - <doNotGenerate> - aStream nextPutAll: - ((self headerType: obj) caseOf: { - [HeaderTypeFree] -> [' HeaderTypeFree (4 bytes)']. - [HeaderTypeShort] -> [' HeaderTypeShort (4 bytes)']. - [HeaderTypeClass] -> [' HeaderTypeClass (8 bytes)']. - [HeaderTypeSizeAndClass] -> [' HeaderTypeSizeAndClass (12 bytes)'] })! Item was removed: - ----- Method: SpurMemoryManager>>printHeaderTypeOf:on: (in category '*VMMakerUI-debug printing') ----- - printHeaderTypeOf: objOop on: aStream - <doNotGenerate> - aStream - nextPutAll: ((self numSlotsOfAny: objOop) >= self numSlotsMask - ifTrue: [' hdr16 '] - ifFalse: [' hdr8 ']); - nextPut: ((self isImmutable: objOop) ifTrue: [$i] ifFalse: [$.]); - nextPut: ((self isRemembered: objOop) ifTrue: [$r] ifFalse: [$.]); - nextPut: ((self isPinned: objOop) ifTrue: [$p] ifFalse: [$.]); - nextPut: ((self isMarked: objOop) ifTrue: [$m] ifFalse: [$.]); - nextPut: ((self isGrey: objOop) ifTrue: [$g] ifFalse: [$.])! Item was changed: ----- Method: StackInterpreterSimulator>>evaluatePrinter:on: (in category '*VMMakerUI-user interface') ----- evaluatePrinter: aBlock on: aStream "Hack to redirect printing to aStream, here to avoid reimplementing all the printing machinery." + | savedTranscript | - | savedTraceOn savedTranscript | - savedTraceOn := traceOn. savedTranscript := transcript. - traceOn := true. transcript := aStream. ^aBlock ensure: + [transcript := savedTranscript]! - [traceOn := savedTraceOn. transcript := savedTranscript]!

1 0

VM Maker: VMMaker.oscog-eem.3075.mcz
by commits＠source.squeak.org 28 Sep '21

28 Sep '21

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3075.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3075 Author: eem Time: 28 September 2021, 10:49:06.44924 am UUID: 094f2144-ced1-4fff-a1c0-c2949bf186b4 Ancestors: VMMaker.oscog-eem.3074 StackInterpreter: Major change to debug printing so that the platform error handlers can print the call stack to a specific FILE * stream, not simply hack stdout via pushOutputFile. transcript now becomes a FILE * inst var of StackInterpreter; all printing goes to this file. withRedirectedOutputTo:do: is used to switch it to another stream and implement printCallStackOn: et al. See protocol "debug printing redirected". Platform changes to follow. P.S. this commit may be broken because it will be followed by one for ThreasdedFFIPlugin failure codes which is saved for the subsequent commit using the Ignore facility. =============== Diff against VMMaker.oscog-eem.3074 =============== Item was added: + ----- Method: CArray>>copyFrom:to: (in category 'converting') ----- + copyFrom: start to: stop + "Coercion support for Printf" + | string n | + unitSize = 1 ifTrue: + [string := ByteString new: (n := stop - start + 1). + interpreter strncpy: string _: self _: n. + ^string]. + unitSize = 4 ifTrue: + [string := WideString new: (n := stop - start + 1). + interpreter strncpy: string _: self _: n * 4. + ^string]. + self halt! Item was changed: ----- Method: CCodeGenerator>>cLiteralFor: (in category 'C code generator') ----- cLiteralFor: anObject "Return a string representing the C literal value for the given object." anObject isNumber ifTrue: [anObject isInteger ifTrue: [| hex dec useHexa | hex := anObject printStringBase: 16. dec := anObject printStringBase: 10. useHexa := (anObject > 255 and: [(hex asSet size * 3) <= (dec asSet size * 2) or: [((hex as: RunArray) runs size * 4) < ((dec as: RunArray) runs size * 3)]]) or: [anObject > 0 and: [(anObject >> anObject lowBit + 1) isPowerOfTwo and: [(anObject highBit = anObject lowBit and: [anObject > 65536]) or: [anObject highBit - anObject lowBit >= 4]]]]. ^self cLiteralForInteger: anObject hex: useHexa]. anObject isFloat ifTrue: [^anObject printString]] ifFalse: [anObject isSymbol ifTrue: [^self cFunctionNameFor: anObject]. anObject isString ifTrue: [^'"', (anObject copyReplaceAll: (String with: Character cr) with: '\n') , '"']. anObject == nil ifTrue: [^ 'null' ]. anObject == true ifTrue: [^ '1' ]. anObject == false ifTrue: [^ '0' ]. anObject isCharacter ifTrue: + [anObject == $' ifTrue: [^'''\''''']. "i.e. '\''" + anObject asInteger = 9 ifTrue: [^'''\t''']. + anObject asInteger = 13 ifTrue: [^'''\n''']. + ^anObject asString printString]]. - [^anObject == $' - ifTrue: ['''\'''''] "i.e. '\''" - ifFalse: [anObject asString printString]]]. self error: 'Warning: A Smalltalk literal could not be translated into a C constant: ', anObject printString. ^'"XXX UNTRANSLATABLE CONSTANT XXX"'! Item was changed: ----- Method: CCodeGenerator>>cLiteralForPrintfString: (in category 'C code generator') ----- cLiteralForPrintfString: aString + ^(((('"', (PrintfFormatString new setFormat: aString) transformForVMMaker, '"') + copyReplaceAll: '16r%p' with: '%p') + copyReplaceAll: '16r%' with: '0x%') + copyReplaceAll: (String with: Character cr) with: '\n') + copyReplaceAll: (String with: Character tab) with: '\t'! - ^(('"', (PrintfFormatString new setFormat: aString) transformForVMMaker, '"') - copyReplaceAll: (String with: Character cr) with: '\n') - copyReplaceAll: (String with: Character tab) with: '\t'! Item was added: + ----- Method: CoInterpreter>>dumpPrimTraceLogOn: (in category 'debug printing redirected') ----- + dumpPrimTraceLogOn: aStdioStream + "Print the prim trace log on a specific output stream." + <export: true> "essential for writing crash.dmp; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" + <var: 'aStdioStream' type: #'FILE *'> + self + withRedirectedOutputTo: aStdioStream + do: [self dumpPrimTraceLog]! Item was removed: - ----- Method: CoInterpreter>>dumpTraceLog (in category 'debug support') ----- - dumpTraceLog - <api> - "The trace log is a circular buffer of pairs of entries. If there is - an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries. - If there is something at traceLogIndex it has wrapped." - <inline: false> - (traceLog at: (self safe: traceLogIndex - 3 mod: TraceBufferSize)) = 0 ifTrue: [^self]. - (traceLog at: traceLogIndex) ~= 0 ifTrue: - [traceLogIndex to: TraceBufferSize - 3 by: 3 do: - [:i| self printLogEntryAt: i]]. - - 0 to: traceLogIndex - 3 by: 3 do: - [:i| self printLogEntryAt: i]! Item was changed: ----- Method: CoInterpreter>>printCogMethod: (in category 'debug printing') ----- printCogMethod: cogMethod <export: true> "useful for VM debugging; use export: so it will be accessible on win32" <api> <var: #cogMethod type: #'CogMethod *'> | address primitive | self cCode: '' inSmalltalk: + [transcript ensureCr. - [self transcript ensureCr. cogMethod isInteger ifTrue: [^self printCogMethod: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]. address := cogMethod asInteger. self printHex: address; print: ' <-> '; printHex: address + cogMethod blockSize. cogMethod cmType = CMMethod ifTrue: [self print: ': method: '; printHex: cogMethod methodObject. primitive := self primitiveIndexOfMethod: cogMethod methodObject header: cogMethod methodHeader. primitive ~= 0 ifTrue: [self print: ' prim '; printNum: primitive]. (objectMemory addressCouldBeObj: cogMethod methodObject) ifTrue: [cogMethod cmIsFullBlock ifTrue: [self print: ' [full]'] ifFalse: [(objectMemory addressCouldBeObj: (self methodClassOf: cogMethod methodObject)) ifTrue: [self space; printNameOfClass: (self methodClassOf: cogMethod methodObject) count: 2]]]]. cogMethod cmType = CMBlock ifTrue: [self print: ': block home: '; printHex: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod asUnsignedInteger]. cogMethod cmType = CMClosedPIC ifTrue: [self print: ': Closed PIC N: '; printHex: cogMethod cPICNumCases]. cogMethod cmType = CMOpenPIC ifTrue: [self print: ': Open PIC ']. self print: ' selector: '; printHex: cogMethod selector. cogMethod selector = objectMemory nilObject ifTrue: [| s | (cogMethod cmType = CMMethod and: [(s := self maybeSelectorOfMethod: cogMethod methodObject) notNil]) ifTrue: [self print: ' (nil: '; printStringOf: s; print: ')'] ifFalse: [self print: ' (nil)']] ifFalse: [self space; printStringOf: cogMethod selector]. self cr! Item was changed: ----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') ----- printFrame: theFP WithSP: theSP <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" | theMethod theMethodEnd numArgs numTemps rcvrAddress topThing | <inline: false> <var: #theFP type: #'char *'> <var: #theSP type: #'char *'> <var: #addr type: #'char *'> <var: #rcvrAddress type: #'char *'> <var: #cogMethod type: #'CogBlockMethod *'> <var: #homeMethod type: #'CogMethod *'> + self cCode: '' inSmalltalk: [transcript ensureCr]. - self cCode: '' inSmalltalk: [self transcript ensureCr]. (stackPages couldBeFramePointer: theFP) ifNil: [self printHexPtr: theFP; print: ' is not in the stack zone?!!'; cr. ^nil]. (self isMachineCodeFrame: theFP) ifTrue: [| cogMethod homeMethod | cogMethod := self mframeCogMethod: theFP. homeMethod := self mframeHomeMethod: theFP. theMethod := homeMethod asInteger. theMethodEnd := homeMethod asInteger + homeMethod blockSize. numArgs := cogMethod cmNumArgs. numTemps := self temporaryCountOfMethodHeader: homeMethod methodHeader] ifFalse: [theMethod := self frameMethodObject: theFP. theMethodEnd := theMethod + (objectMemory sizeBitsOfSafe: theMethod). numArgs := self iframeNumArgs: theFP. numTemps := self tempCountOf: theMethod]. (self frameIsBlockActivation: theFP) ifTrue: [| rcvrOrClosure | "No BlockLocalTempCounter in the Cogit's C code, so quick hack is to use numCopied + numArgs" rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP. ((objectMemory isNonImmediate: rcvrOrClosure) and: [(objectMemory addressCouldBeObj: rcvrOrClosure) and: [(objectMemory fetchClassOfNonImm: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]]) ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)] ifFalse: [numTemps := numArgs]]. self shortPrintFrame: theFP. (self isBaseFrame: theFP) ifTrue: [self printFrameOop: '(caller ctxt' at: theFP + (self frameStackedReceiverOffset: theFP) + (2 * objectMemory wordSize). self printFrameOop: '(saved ctxt' at: theFP + (self frameStackedReceiverOffset: theFP) + (1 * objectMemory wordSize)]. self printFrameOop: 'rcvr/clsr' at: theFP + FoxCallerSavedIP + ((numArgs + 1) * objectMemory wordSize). numArgs to: 1 by: -1 do: [:i| self printFrameOop: 'arg' index: numArgs - i at: theFP + FoxCallerSavedIP + (i * objectMemory wordSize)]. self printFrameThing: 'caller ip' at: theFP + FoxCallerSavedIP extraString: ((stackPages longAt: theFP + FoxCallerSavedIP) = cogit ceReturnToInterpreterPC ifTrue: ['ceReturnToInterpreter']). self printFrameThing: 'saved fp' at: theFP + FoxSavedFP. self printFrameMethodFor: theFP. (self isMachineCodeFrame: theFP) ifTrue: [self printFrameFlagsForFP: theFP]. self printFrameOop: 'context' at: theFP + FoxThisContext. (self isMachineCodeFrame: theFP) ifFalse: [self printFrameFlagsForFP: theFP]. (self isMachineCodeFrame: theFP) ifTrue: [rcvrAddress := theFP + FoxMFReceiver] ifFalse: [self printFrameThing: 'saved ip' at: theFP + FoxIFSavedIP extra: ((self iframeSavedIP: theFP) = 0 ifTrue: [0] ifFalse: [(self iframeSavedIP: theFP) - theMethod + 2 - objectMemory baseHeaderSize]). rcvrAddress := theFP + FoxIFReceiver]. self printFrameOop: 'receiver' at: rcvrAddress. topThing := stackPages longAt: theSP. (self oop: topThing isGreaterThanOrEqualTo: theMethod andLessThan: theMethodEnd) ifTrue: [rcvrAddress - objectMemory wordSize to: theSP + objectMemory wordSize by: objectMemory wordSize negated do: [:addr| | index | index := rcvrAddress - addr / objectMemory wordSize + numArgs. index <= numTemps ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr] ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP) ifTrue: ['temp/stck'] ifFalse: ['stck']) at: addr]]. self printFrameThing: 'frame ip' at: theSP extra: ((self isMachineCodeFrame: theFP) ifTrue: [topThing - theMethod] ifFalse: [topThing - theMethod + 2 - objectMemory baseHeaderSize])] ifFalse: [rcvrAddress - objectMemory wordSize to: theSP by: objectMemory wordSize negated do: [:addr| | index | index := rcvrAddress - addr / objectMemory wordSize + numArgs. index <= numTemps ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr] ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP) ifTrue: ['temp/stck'] ifFalse: ['stck']) at: addr]]]! Item was removed: - ----- Method: CoInterpreter>>printLogEntryAt: (in category 'debug support') ----- - printLogEntryAt: i - <inline: false> - | intOrClass selectorMethodOrProcess source | - intOrClass := traceLog at: i. - selectorMethodOrProcess := traceLog at: i + 1. - source := traceLog at: i + 2. - source <= TraceIsFromInterpreter ifTrue: - [self print: (traceSources at: source); space]. - (objectMemory isIntegerObject: intOrClass) - ifTrue: - [intOrClass = TraceStackOverflow ifTrue: - [self print: 'stack overflow']. - intOrClass = TraceContextSwitch ifTrue: - [self print: 'context switch from '; printHex: selectorMethodOrProcess]. - intOrClass = TraceBlockActivation ifTrue: - [self print: ' [] in '; printHex: selectorMethodOrProcess]. - intOrClass = TraceBlockCreation ifTrue: - [self print: 'create [] '; printHex: selectorMethodOrProcess]. - intOrClass = TraceIncrementalGC ifTrue: - [self print: 'incrementalGC']. - intOrClass = TraceFullGC ifTrue: - [self print: 'fullGC']. - intOrClass = TraceCodeCompaction ifTrue: - [self print: 'compactCode']. - intOrClass = TraceVMCallback ifTrue: - [self print: 'callback']. - intOrClass = TraceVMCallbackReturn ifTrue: - [self print: 'return from callback']] - ifFalse: - [self space; printNameOfClass: intOrClass count: 5; print: '>>'; printStringOf: selectorMethodOrProcess]. - source > TraceIsFromInterpreter ifTrue: - [self space; print: (traceSources at: source)]. - self cr! Item was changed: ----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') ----- printMethodCacheFor: thing <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" | 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: [] inSmalltalk: [self transcript ensureCr]. self printNum: i; space; printHexnp: i; cr; tab. (objectMemory isBytesNonImm: s) + ifTrue: ['%p %.*s\n' f: transcript printf: { s. objectMemory numBytesOfBytes: s. objectMemory firstIndexableField: s }] - ifTrue: [self cCode: 'printf("%" PRIxSQPTR " %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))' - inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]] 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: (in category 'debug support') ----- printPrimLogEntryAt: i <inline: false> | intOrSelector | intOrSelector := primTraceLog at: i. (objectMemory isImmediate: intOrSelector) ifTrue: [intOrSelector = TraceIncrementalGC ifTrue: [self print: '**IncrementalGC**'. ^nil]. intOrSelector = TraceFullGC ifTrue: [self print: '**FullGC**'. ^nil]. intOrSelector = TraceCodeCompaction ifTrue: [self print: '**CompactCode**'. ^nil]. intOrSelector = TraceStackOverflow ifTrue: [self print: '**StackOverflow**'. ^nil]. intOrSelector = TracePrimitiveFailure ifTrue: [self print: '**PrimitiveFailure**'. ^nil]. intOrSelector = TracePrimitiveRetry ifTrue: [self print: '**PrimitiveRetry**'. ^nil]. self print: '???'] ifFalse: [intOrSelector = 0 + ifTrue: ['%d!!!!!!' f: transcript printf: i] - ifTrue: [self printNum: i; print: '!!!!!!'] ifFalse: [objectMemory safePrintStringOf: intOrSelector]]! 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 an amount of memory to its object heap. V3: desiredHeapSize is the total size of the heap. Fail if the image has an unknown format or requires more than the specified amount of memory. Spur: desiredHeapSize is ignored; this routine will attempt to provide at least extraVMMemory's ammount of free space after the image is loaded, taking any free space in the image into account. extraVMMemory is stored in the image header and is accessible as vmParameterAt: 23. If extraVMMemory is 0, the value defaults to the default grow headroom. Fail if the image has an unknown format or if sufficient memory cannot be allocated. 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." | swapBytes headerStart headerSize headerFlags dataSize bytesRead bytesToShift heapSize oldBaseAddr minimumMemory allocationReserve cogCodeBase firstSegSize hdrNumStackPages hdrEdenBytes hdrCogCodeSize hdrMaxExtSemTabSize | <var: #f type: #sqImageFile> <var: #heapSize type: #usqInt> <var: #dataSize type: #'size_t'> <var: #minimumMemory type: #usqInt> <var: #desiredHeapSize type: #usqInt> <var: #allocationReserve type: #usqInt> <var: #headerStart type: #squeakFileOffsetType> <var: #imageOffset type: #squeakFileOffsetType> + transcript := #stdout. "stdout is not available at compile time. this is the earliest available point." metaclassNumSlots := 6. "guess Metaclass instSize" classNameIndex := 6. "guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1" swapBytes := self checkImageVersionFrom: f startingAt: imageOffset. headerStart := (self sqImageFilePosition: f) - 4. "record header start position" headerSize := self getWord32FromFile: 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 getWord32FromFile: f swap: swapBytes. "N.B. ignored in V3." 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: [cogit defaultCogCodeSize] ifFalse: [desiredCogCodeSize := hdrCogCodeSize]]. "set for vmParameter 47" cogCodeSize > cogit maxCogCodeSize ifTrue: [cogCodeSize := cogit maxCogCodeSize]. hdrEdenBytes := self getWord32FromFile: 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]. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. Preserve it to be polite to other VMs." the2ndUnknownShort := self getShortFromFile: f swap: swapBytes. firstSegSize := self getLongFromFile: f swap: swapBytes. objectMemory firstSegmentSize: firstSegSize. "compare memory requirements with availability" allocationReserve := self interpreterAllocationReserveBytes. minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed" + dataSize + objectMemory newSpaceBytes + allocationReserve. "Compute how much space is needed for the initial heap allocation. no need to include the stackZone; this is alloca'ed. no need to include the JIT code zone size; this is allocated separately." objectMemory hasSpurMemoryManagerAPI ifTrue: [| freeOldSpaceInImage headroom | freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes. headroom := objectMemory initialHeadroom: extraVMMemory givenFreeOldSpaceInImage: freeOldSpaceInImage. heapSize := objectMemory roundUpHeapSize: dataSize + headroom + objectMemory newSpaceBytes + (headroom > allocationReserve ifTrue: [0] ifFalse: [allocationReserve])] ifFalse: [heapSize := desiredHeapSize + objectMemory newSpaceBytes + (desiredHeapSize - dataSize > allocationReserve ifTrue: [0] ifFalse: [allocationReserve]). heapSize < minimumMemory ifTrue: [self insufficientMemorySpecifiedError]]. "allocateJITMemory will assign the actual size allocated, which is rounded up to a page boundary." cogCodeBase := self allocateJITMemory: (self addressOf: cogCodeSize). "allocate a contiguous block of memory for the Squeak heap and ancilliary data structures" (self allocateMemory: heapSize minimum: minimumMemory imageFile: f headerSize: headerSize) asUnsignedInteger ifNil: [self insufficientMemoryAvailableError] ifNotNil: [:mem| "cannot clash with the variable memory still in use in NewCoObjectMemory and superclasses" objectMemory setHeapBase: (heapBase := mem) memoryLimit: mem + heapSize endOfMemory: mem + 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 := objectMemory readHeapFromImageFile: f dataBytes: dataSize. bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. self ensureImageFormatIsUpToDate: swapBytes. "compute difference between old and new memory base addresses" bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. self initializeInterpreter: bytesToShift. "adjusts all oops to new location" cogit initializeCodeZoneFrom: cogCodeBase upTo: cogCodeBase + cogCodeSize. ^dataSize! Item was changed: ----- Method: CoInterpreter>>reportMinimumUnusedHeadroom (in category 'debug support') ----- reportMinimumUnusedHeadroom "Report the stack page size and minimum unused headroom to stdout." + <export: true> + 'stack page bytes %ld available headroom %ld minimum unused headroom %ld\n' + f: transcript + printf: {self stackPageByteSize. + self stackPageByteSize - self stackLimitBytes - self stackLimitOffset. + self minimumUnusedHeadroom }! - <api> - self cCode: - [self pri: 'stack page bytes %lld available headroom %lld minimum unused headroom %lld\n' - n: self stackPageByteSize asUnsignedLongLong - t: (self stackPageByteSize - self stackLimitBytes - self stackLimitOffset) asUnsignedLongLong - f: self minimumUnusedHeadroom asUnsignedLongLong] - inSmalltalk: - ["CogVMSimulator new initStackPagesForTests reportMinimumUnusedHeadroom" - self print: 'stack page bytes '; printNum: self stackPageByteSize; - print: ' available headroom '; printNum: self stackPageByteSize - self stackLimitBytes - self stackLimitOffset; - print: ' minimum unused headroom '; printNum: self minimumUnusedHeadroom; - cr]! Item was added: + ----- Method: CoInterpreter>>reportMinimumUnusedHeadroomOn: (in category 'debug printing redirected') ----- + reportMinimumUnusedHeadroomOn: aStdioStream + "Report the stack page size and minimum unused headroom to a stream." + <export: true> + <var: 'aStdioStream' type: #'FILE *'> + self + withRedirectedOutputTo: aStdioStream + do: [self reportMinimumUnusedHeadroom]! Item was changed: ----- Method: CoInterpreter>>shortPrintFrame: (in category 'debug printing') ----- shortPrintFrame: theFP <inline: false> <var: #theFP type: #'char *'> | rcvr mthd | (stackPages couldBeFramePointer: theFP) ifFalse: [self print: 'invalid frame pointer'; cr. ^nil]. rcvr := self frameReceiver: theFP. mthd := self frameMethodObject: theFP. + self printHexPtrnp: theFP. - self printHexPtr: theFP. self space. self printChar: ((self isMachineCodeFrame: theFP) ifTrue: [$M] ifFalse: [$I]). self space. self printActivationNameFor: mthd receiver: rcvr isBlock: (self frameIsBlockActivation: theFP) firstTemporary: (self temporary: 0 in: theFP). self space. self shortPrintOop: rcvr "shortPrintOop: adds a cr"! Item was removed: - ----- Method: CoInterpreter>>transcript (in category 'simulation') ----- - transcript - <doNotGenerate> - ^Transcript! Item was removed: - ----- Method: CoInterpreter>>warning: (in category 'cog jit support') ----- - warning: aString - <api: 'extern void warning(const char *s)'> - <doNotGenerate> - self transcript cr; nextPutAll: aString; flush! Item was removed: - ----- Method: CoInterpreterMT>>printLogEntryAt: (in category 'debug support') ----- - printLogEntryAt: i - <inline: false> - | intOrClass selectorOrMethod source | - intOrClass := traceLog at: i. - selectorOrMethod := traceLog at: i + 1. - self printNum: ((traceLog at: i + 2) bitShift: -16); space. - source := (traceLog at: i + 2) bitAnd: 16rFFFF. - source <= TraceIsFromInterpreter ifTrue: - [self print: (traceSources at: source); space]. - (objectMemory isIntegerObject: intOrClass) - ifTrue: - [| value | - value := objectMemory integerValueOf: selectorOrMethod. - intOrClass = TraceContextSwitch ifTrue: - [self print: 'context switch']. - intOrClass = TraceBlockActivation ifTrue: - [self print: ' [] in '; printHex: selectorOrMethod]. - intOrClass = TraceBlockCreation ifTrue: - [self print: 'create [] '; printHex: selectorOrMethod]. - intOrClass = TraceIncrementalGC ifTrue: - [self print: 'incrementalGC']. - intOrClass = TraceFullGC ifTrue: - [self print: 'fullGC']. - intOrClass = TraceCodeCompaction ifTrue: - [self print: 'compactCode']. - intOrClass = TraceVMCallback ifTrue: - [self print: 'callback']. - intOrClass = TraceVMCallbackReturn ifTrue: - [self print: 'return from callback']. - intOrClass = TraceThreadSwitch ifTrue: - [self print: 'thread switch '; printNum: (value bitAnd: 16rFFFF); print: '->'; printNum: (value >> 16)]. - intOrClass = TracePreemptDisowningThread ifTrue: - [self print: 'preempt thread '; printNum: value]. - intOrClass = TraceOwnVM ifTrue: - [self print: 'ownVM '; printNum: value]. - intOrClass = TraceDisownVM ifTrue: - [self print: 'disownVM '; printHex: value]] - ifFalse: - [self space; printNameOfClass: intOrClass count: 5; print: '>>'; printStringOf: selectorOrMethod]. - source > TraceIsFromInterpreter ifTrue: - [self space; print: (traceSources at: source)]. - self cr! Item was changed: CoInterpreterMT subclass: #CogVMSimulator + instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends myBitBlt displayForm fakeForm imageName pluginList mappedPluginEntries quitBlock displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters eventQueue effectiveCogCodeSize expectedSends expecting inputSemaphoreIndex zeroNextProfileTickCount perMethodProfile' - instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends traceOn myBitBlt displayForm fakeForm imageName pluginList mappedPluginEntries quitBlock transcript displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters eventQueue effectiveCogCodeSize expectedSends expecting inputSemaphoreIndex zeroNextProfileTickCount perMethodProfile' classVariableNames: 'ByteCountsPerMicrosecond ExpectedSends NLRFailures NLRSuccesses StackAlteringPrimitives' poolDictionaries: '' category: 'VMMaker-JITSimulation'! !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0! This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. Remember that you can test the Cogit using its class-side in-image compilation facilities. To see the thing actually run, you could (after backing up this image and changes), execute (CogVMSimulator new openOn: Smalltalk imageName) test and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. Here's an example to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff: (CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit)) desiredNumStackPages: 8; openOn: '/Users/eliot/Cog/startreader.image'; openAsMorph; run Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out. | cos proc opts | CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)). CogVMSimulator chooseAndInitCogitClassWithOpts: opts. cos := CogVMSimulator new. "cos initializeThreadSupport." "to test the multi-threaded VM" cos desiredNumStackPages: 8. "to set the size of the stack zone" "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone" cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image" "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector" proc := cos cogit processor. "cos cogit sendTrace: 7." "turn on tracing" "set a complex breakpoint at a specific point in machine code" "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg| cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1". "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit" "cos cogit setBreakMethod: 16rB38880." cos openAsMorph; "toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window" halt; run! Item was removed: - ----- Method: CogVMSimulator>>cr (in category 'debug printing') ----- - cr - - traceOn ifTrue: [ transcript cr; flush ].! Item was changed: ----- Method: CogVMSimulator>>ensureDebugAtEachStepBlock (in category 'testing') ----- ensureDebugAtEachStepBlock atEachStepBlock := [printFrameAtEachStep ifTrue: [self printFrame: localFP WithSP: localSP]. printBytecodeAtEachStep ifTrue: + [self printCurrentBytecodeOn: transcript]. - [self printCurrentBytecodeOn: transcript. - transcript cr; flush]. byteCount = breakCount ifTrue: ["printFrameAtEachStep :=" printBytecodeAtEachStep := true]]! Item was changed: ----- Method: CogVMSimulator>>flush (in category 'debug printing') ----- flush + transcript flush. + "We *always* want to make transcript visible on flush" + TranscriptStream forceUpdate ifFalse: + [transcript changed: #appendEntry]! - traceOn ifTrue: - [transcript flush. - "We *always* want to make output visible on flush" - TranscriptStream forceUpdate ifFalse: - [transcript changed: #appendEntry]]! Item was changed: ----- Method: CogVMSimulator>>initialize (in category 'initialize-release') ----- initialize "Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." super initialize. transcript := Transcript. objectMemory ifNil: [objectMemory := InitializationOptions at: #ObjectMemorySimulator ifPresent: [:className| (Smalltalk classNamed: className) new] ifAbsent: [self class objectMemoryClass simulatorClass new]]. cogit ifNil: [cogit := self class cogitClass new setInterpreter: self]. objectMemory coInterpreter: self cogit: cogit. (cogit numRegArgs > 0 and: [VMClass initializationOptions at: #CheckStackDepth ifAbsent: [true]]) ifTrue: [debugStackDepthDictionary := Dictionary new]. cogThreadManager ifNotNil: [super initialize]. self assert: ConstMinusOne = (objectMemory integerObjectOf: -1). cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())" enableCog := true. methodCache := Array new: MethodCacheSize. nsMethodCache := Array new: NSMethodCacheSize. atCache := nil. self flushMethodCache. cogCompiledCodeCompactionCalledFor := false. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. self initializePluginEntries. desiredNumStackPages := InitializationOptions at: #desiredNumStackPages ifAbsent: [0]. desiredEdenBytes := InitializationOptions at: #desiredEdenBytes ifAbsent: [0]. desiredCogCodeSize := InitializationOptions at: #desiredCogCodeSize ifAbsent: [0]. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds. maxLiteralCountForCompile := MaxLiteralCountForCompile. minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile. flagInterpretedMethods := false. "initialize InterpreterSimulator variables used for debugging" byteCount := lastPollCount := sendCount := lookupCount := 0. quitBlock := [^self close]. - traceOn := true. printSends := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form. suppressHeartbeatFlag := deferSmash := deferredSmash := false. systemAttributes := Dictionary new. primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0). primTraceLogIndex := 0. traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0). traceLogIndex := 0. traceSources := TraceSources. statCodeCompactionCount := 0. statCodeCompactionUsecs := 0. extSemTabSize := 256. zeroNextProfileTickCount := 0! Item was changed: ----- Method: CogVMSimulator>>logOfBytesVerify:fromFileNamed:fromStart: (in category 'testing') ----- logOfBytesVerify: nBytes fromFileNamed: fileName fromStart: loggingStart "Verify a questionable interpreter against a successful run" "self logOfBytesVerify: 10000 fromFileNamed: 'clone32Bytecodes.log' " | logFile rightWord prevCtxt | logFile := (FileStream readOnlyFileNamed: fileName) binary. transcript clear. byteCount := 0. quitBlock := [^self close]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. prevCtxt := 0. prevCtxt := prevCtxt. [byteCount < nBytes] whileTrue: [ " byteCount > 14560 ifTrue: [self externalizeIPandSP. prevCtxt = activeContext ifFalse: + [prevCtxt := activeContext. + transcript cr; nextPutAll: (self printTop: 2); endEntry]. + transcript + cr; print: byteCount; nextPutAll: ': ' , (activeContext hex); space; + print: (instructionPointer - method - (BaseHeaderSize - 2)); + nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space; + nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space; + print: (self stackPointerIndex - CtxtTempFrameStart + 1); endEntry. - [prevCtxt := activeContext. - transcript cr; nextPutAll: (self printTop: 2); endEntry]. - transcript cr; print: byteCount; nextPutAll: ': ' , (activeContext hex); space; - print: (instructionPointer - method - (BaseHeaderSize - 2)); - nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space; - nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space; - print: (self stackPointerIndex - TempFrameStart + 1); endEntry. byteCount = 14590 ifTrue: [self halt]]. " loggingStart >= byteCount ifTrue: [rightWord := logFile nextWord. currentBytecode = rightWord ifFalse: [self halt: 'halt at ', byteCount printString]]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. self externalizeIPandSP. logFile close. self inform: nBytes printString , ' bytecodes verfied.'! Item was changed: ----- Method: CogVMSimulator>>logOfSendsVerify:fromFileNamed:fromStart: (in category 'testing') ----- logOfSendsVerify: nSends fromFileNamed: fileName fromStart: loggingStart "Write a log file for testing a flaky interpreter on the same image" "self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' " | logFile priorFrame rightSelector prevCtxt | logFile := FileStream readOnlyFileNamed: fileName. transcript clear. byteCount := 0. sendCount := 0. priorFrame := localFP. quitBlock := [^self close]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. prevCtxt := 0. prevCtxt := prevCtxt. [sendCount < nSends] whileTrue: [ " byteCount>500 ifTrue: [byteCount>550 ifTrue: [self halt]. self externalizeIPandSP. prevCtxt = localFP ifFalse: [prevCtxt := localFP. transcript cr; nextPutAll: (self printTop: 2); endEntry]. transcript cr; print: byteCount; nextPutAll: ': ' , (localFP hex); space; print: (instructionPointer - method - (BaseHeaderSize - 2)); nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space; nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space; + print: (self stackPointerIndex - CtxtTempFrameStart + 1); endEntry. - print: (self stackPointerIndex - TempFrameStart + 1); endEntry. ]. " self dispatchOn: currentBytecode in: BytecodeTable. localFP = priorFrame ifFalse: [sendCount := sendCount + 1. loggingStart >= sendCount ifTrue: [rightSelector := logFile nextLine. (self stringOf: messageSelector) = rightSelector ifFalse: [self halt: 'halt at ', sendCount printString]]. priorFrame := localFP]. self incrementByteCount]. self externalizeIPandSP. logFile close. self inform: nSends printString , ' sends verfied.'! Item was removed: - ----- Method: CogVMSimulator>>print: (in category 'debug printing') ----- - print: it - - traceOn ifTrue: - [it isString ifTrue: [transcript nextPutAll: it] ifFalse: [it printOn: transcript]]! Item was removed: - ----- Method: CogVMSimulator>>printChar: (in category 'debug printing') ----- - printChar: aByte - - traceOn ifTrue: - [(aByte between: 0 and: 255) - ifTrue: [transcript nextPut: aByte asCharacter] - ifFalse: [transcript nextPutAll: 'BAD CHARACTER '. - aByte printOn: transcript base: 16]]! Item was changed: ----- Method: CogVMSimulator>>printCogMethod:on: (in category 'simulation only') ----- printCogMethod: cogMethod on: aStream <doNotGenerate> + ^self + evaluatePrinter: [self printCogMethod: cogMethod] + on: aStream! - | oldTranscript | - oldTranscript := transcript. - transcript := aStream. - [self printCogMethod: cogMethod] ensure: - [transcript := oldTranscript]! Item was removed: - ----- Method: CogVMSimulator>>printFloat: (in category 'debug printing') ----- - printFloat: f - - traceOn ifTrue: [ transcript print: f ]! Item was removed: - ----- Method: CogVMSimulator>>printHex: (in category 'debug printing') ----- - printHex: anInteger - traceOn ifTrue: - [self printHex: anInteger on: transcript]! Item was removed: - ----- Method: CogVMSimulator>>printHexnp: (in category 'debug printing') ----- - printHexnp: anInteger - - traceOn ifTrue: - [transcript nextPutAll: ((anInteger ifNil: [0]) asInteger storeStringBase: 16)]! Item was removed: - ----- Method: CogVMSimulator>>printHexnpnp: (in category 'debug printing') ----- - printHexnpnp: anInteger - "Print n in hex, in the form '1234', unpadded" - traceOn ifTrue: - [transcript nextPutAll: ((anInteger ifNil: [0]) printStringBase: 16)]! Item was removed: - ----- Method: CogVMSimulator>>printLogEntryAt: (in category 'multi-threading simulation switch') ----- - printLogEntryAt: i - "This method includes or excludes CoInterpreterMT methods as required. - Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" - - ^self perform: #printLogEntryAt: - withArguments: {i} - inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was removed: - ----- Method: CogVMSimulator>>printNum: (in category 'debug printing') ----- - printNum: anInteger - - traceOn ifTrue: [ transcript print: anInteger ].! Item was changed: ----- Method: CogVMSimulator>>printRumpCStackForThread: (in category 'rump c stack') ----- printRumpCStackForThread: thread | range start coldTop | range := self cStackRangeForThreadIndex: thread index. + start := range first bitClear: objectMemory tagMask. coldTop := range last. [start < coldTop and: [(objectMemory longAt: start) = 0]] whileTrue: [start := start + objectMemory wordSize]. (start = coldTop and: [(objectMemory longAt: start) = 0]) ifTrue: [^self]. start := start - (2 * objectMemory wordSize) max: range start. transcript nextPutAll: 'thread '; print: thread index. thread index = cogThreadManager getVMOwner ifTrue: [transcript nextPut: $*]. transcript cr. self printRumpCStackFrom: start to: coldTop cfp: thread cFramePointer csp: thread cStackPointer. range first < start ifTrue: [self print: 'zeros...'; cr]! Item was removed: - ----- Method: CogVMSimulator>>printStringForCurrentBytecode (in category 'debug printing') ----- - printStringForCurrentBytecode - ^String streamContents: [:str| self printCurrentBytecodeOn: str]! Item was removed: - ----- Method: CogVMSimulator>>space (in category 'debug printing') ----- - space - - traceOn ifTrue: [ transcript space ]! Item was removed: - ----- Method: CogVMSimulator>>sqShrinkMemory:By: (in category 'memory access') ----- - sqShrinkMemory: oldLimit By: delta - transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr. - - ^ oldLimit! Item was removed: - ----- Method: CogVMSimulator>>tab (in category 'debug printing') ----- - tab - - traceOn ifTrue: [ transcript tab ].! Item was removed: - ----- Method: CogVMSimulator>>transcript (in category 'simulation only') ----- - transcript - ^transcript! Item was removed: - ----- Method: CogVMSimulator>>transcript: (in category 'simulation only') ----- - transcript: aTranscript - transcript := aTranscript! Item was changed: ----- Method: Cogit>>print: (in category 'printing') ----- print: aString + <doNotGenerate> + coInterpreter print: aString! - <cmacro: '(aString) printf("%s", aString)'> - coInterpreter transcript print: aString! Item was changed: ----- Method: Cogit>>printPCMapPairsFor: (in category 'method map') ----- printPCMapPairsFor: cogMethod <doNotGenerate> "<api> <var: 'cogMethod' type: #'CogMethod *'> <var: 'mapByte' type: #'unsigned char'>" | mcpc map mapByte annotation value | mcpc := self firstMappedPCFor: cogMethod. map := self mapStartFor: cogMethod. [(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: [annotation := mapByte >> AnnotationShift. annotation = IsAnnotationExtension ifTrue: [value := (mapByte bitAnd: DisplacementMask) + IsSendCall] ifFalse: [value := annotation. mcpc := mcpc + (backEnd codeGranularity * (annotation = IsDisplacementX2N ifTrue: [mapByte - DisplacementX2N << AnnotationShift] ifFalse: [mapByte bitAnd: DisplacementMask]))]. + ((NewspeakVM - coInterpreter - printHexnp: map; - print: ': '. - self - cCode: [self print: '%02x' f: mapByte] - inSmalltalk: - [mapByte < 16 ifTrue: - [coInterpreter putchar: $0]. - coInterpreter printHexnp: mapByte]. - coInterpreter - printChar: $ ; - printNum: annotation; - print: ' ('. - (NewspeakVM and: [value = IsNSSendCall + or: [value between: IsNSSendCall and: IsNSImplicitReceiverSend]]) + ifTrue: + [value caseOf: { + [IsNSSendCall] -> ['NSSendCall']. + [IsNSSelfSend] -> ['NSSelfSend']. + [IsNSDynamicSuperSend] -> ['NSDynamicSuperSend']. + [IsNSImplicitReceiverSend] -> ['NSImplicitReceiverSend'] } + otherwise: [nil]] + ifFalse: + [(BytecodeSetHasDirectedSuperSend + and: [value between: IsDirectedSuperSend and: IsDirectedSuperBindingSend]) + ifTrue: + [value = IsDirectedSuperSend + ifTrue: ['DirectedSuperSend'] + ifFalse: ['DirectedSuperBindingSend']] + ifFalse: + [value + caseOf: { + [IsDisplacementX2N] -> ['DisplacementX2N']. + [IsAnnotationExtension] -> ['AnnotationExtension']. + [IsObjectReference] -> ['ObjectReference']. + [IsAbsPCReference] -> ['AbsPCReference']. + [HasBytecodePC] -> ['HasBytecodePC']. + [IsRelativeCall] -> ['RelativeCall']. + [IsSendCall] -> ['SendCall']. + [IsSuperSend] -> ['SuperSend'] } + otherwise: [nil]]]) + ifNil: ['%lx: %02x %ld (??? %d) 16r%x @ 16r%lx\n' + f: coInterpreter getTranscript + printf: { map. mapByte. annotation. value. mapByte bitAnd: DisplacementMask. mcpc }] + ifNotNil: + [:type| + '%lx: %02x %ld (%s) 16r%x @ 16r%lx\n' + f: coInterpreter getTranscript + printf: { map. mapByte. annotation. type. mapByte bitAnd: DisplacementMask. mcpc }]. - or: [value between: IsNSSendCall and: IsNSImplicitReceiverSend]]) ifTrue: - [value - caseOf: { - [IsNSSendCall] -> [coInterpreter print: 'NSSendCall']. - [IsNSSelfSend] -> [coInterpreter print: 'NSSelfSend']. - [IsNSDynamicSuperSend] -> [coInterpreter print: 'NSDynamicSuperSend']. - [IsNSImplicitReceiverSend] -> [coInterpreter print: 'NSImplicitReceiverSend'] }] ifFalse: - [(BytecodeSetHasDirectedSuperSend - and: [value between: IsDirectedSuperSend and: IsDirectedSuperBindingSend]) ifTrue: - [value - caseOf: { - [IsDirectedSuperSend] -> [coInterpreter print: 'DirectedSuperSend']. - [IsDirectedSuperBindingSend] -> [coInterpreter print: 'DirectedSuperBindingSend'] }] ifFalse: - [value - caseOf: { - [IsDisplacementX2N] -> [coInterpreter print: 'DisplacementX2N']. - [IsAnnotationExtension] -> [coInterpreter print: 'AnnotationExtension']. - [IsObjectReference] -> [coInterpreter print: 'ObjectReference']. - [IsAbsPCReference] -> [coInterpreter print: 'AbsPCReference']. - [HasBytecodePC] -> [coInterpreter print: 'HasBytecodePC']. - [IsRelativeCall] -> [coInterpreter print: 'RelativeCall']. - [IsSendCall] -> [coInterpreter print: 'SendCall']. - [IsSuperSend] -> [coInterpreter print: 'SuperSend'] } - otherwise: [coInterpreter print: '??? '; printHexnp: value]]]. - coInterpreter - print: ') '; - printHexnp: (mapByte bitAnd: DisplacementMask); - printChar: $ ; - putchar: $@; - printHex: mcpc; - cr; - flush. map := map - 1]! Item was changed: ----- Method: CurrentImageCoInterpreterFacade>>printChar: (in category 'printing') ----- printChar: aCharacter + coInterpreter printChar: aCharacter! - coInterpreter transcript nextPut: aCharacter! Item was removed: - ----- Method: CurrentImageCoInterpreterFacade>>putchar: (in category 'printing') ----- - putchar: aCharacter - coInterpreter transcript nextPut: aCharacter! Item was changed: VMClass subclass: #InterpreterPrimitives + instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode secondaryErrorCode exceptionPC inFFIFlags profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields sHEAFn ffiExceptionResponse eventTraceMask' - instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode osErrorCode exceptionPC inFFIFlags profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields newFinalization sHEAFn ffiExceptionResponse eventTraceMask' classVariableNames: 'CrossedX EndOfRun MillisecondClockMask' poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices VMStackFrameOffsets' category: 'VMMaker-Interpreter'! + !InterpreterPrimitives commentStamp: 'eem 9/23/2021 13:20' prior: 0! - !InterpreterPrimitives commentStamp: 'eem 8/24/2018 11:05' prior: 0! InterpreterPrimitives implements most of the VM's core primitives. It is the root of the interpreter hierarchy so as to share the core primitives amongst the varioius interpreters. Instance Variables argumentCount <Integer> + eventTraceMask <Integer> + exceptionPC <Integer> ffiExceptionResponse <Integer> inFFIFlags <Integer> messageSelector <Integer> newMethod <Integer> nextProfileTick <Integer> objectMemory <ObjectMemory> (simulation only) preemptionYields <Boolean> primFailCode <Integer> + secondaryErrorCode <Integer> - osErrorCode <Integer> profileMethod <Integer> profileProcess <Integer> profileSemaphore <Integer> + sHEAFn <Integer> - secHasEnvironmentAccess <Integer> argumentCount - the number of arguments of the current message + eventTraceMask + - a bit mask corresponding to the Event type codes in sq.h that decides what events are printed in primitiveGetNextEvent + + exceptionPC + - the pc of an exception for an exception reporting primitive failure such as PrimErrFFIException + ffiExceptionResponse - controls system response to exceptions during FFI calls. See primitiveFailForFFIException:at: inFFIFlags - flags recording currently only whether the system is in an FFI call messageSelector - the oop of the selector of the current message newMethod - the oop of the result of looking up the current message nextProfileTick - the millisecond clock value of the next profile tick (if profiling is in effect) objectMemory - the memory manager and garbage collector that manages the heap preemptionYields - a boolean controlling the process primitives. If true (old, incorrect, blue-book semantics) a preempted process is sent to the back of its run-queue. If false, a process preempted by a higher-priority process is put back at the head of its run queue, hence preserving cooperative scheduling within priorities. primFailCode - primitive success/failure flag, 0 for success, otherwise the reason code for failure + profileMethod + - the primitive method active when the last profile sample was taken (if any) - osErrorCode - - a 64-bit value settable by external primitives conveying arbitrary error codes from the operating system and/or system libraries + profileProcess + - the process active when the last profile sample was taken + + profileSemaphore + - the semaphore to be signalled when a profile sample is taken; if nil disables profiling + + secondaryErrorCode + - a 64-bit value settable for clonable primitive failures (PrimErrOSError, PrimErrFFIException et al) + profileMethod - the oop of the method at the time nextProfileTick was reached profileProcess - the oop of the activeProcess at the time nextProfileTick was reached profileSemaphore - the oop of the semaphore to signal when nextProfileTick is reached + secondaryErrorCode + - an additional value associated with various primitive failures + + sHEAFn + - the function to call to check if access to the envronment should be granted to primitiveGetenv! - secHasEnvironmentAccess - - the function to call to check if access to the envronment should be granted to primitiveGetenv - ! Item was changed: ----- Method: InterpreterPrimitives class>>declareCVarsIn: (in category 'C translation') ----- declareCVarsIn: aCCodeGen aCCodeGen + var: 'secondaryErrorCode' type: #sqLong; - var: 'osErrorCode' type: #sqLong; var: 'exceptionPC' type: #usqInt; var: 'sHEAFn' declareC: 'int (*sHEAFn)() = 0' "the hasEnvironmentAccess function"! Item was changed: ----- Method: InterpreterPrimitives>>initialize (in category 'initialization') ----- initialize "Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated." + argumentCount := primFailCode := nextProfileTick := secondaryErrorCode := exceptionPC := inFFIFlags := ffiExceptionResponse := eventTraceMask := 0! - argumentCount := primFailCode := nextProfileTick := osErrorCode := exceptionPC := inFFIFlags := ffiExceptionResponse := eventTraceMask := 0. - newFinalization := false! Item was added: + ----- Method: InterpreterPrimitives>>primitiveFailFor:withSecondary: (in category 'primitive support') ----- + primitiveFailFor: reasonCode withSecondary: extraErrorCode + <var: 'extraErrorCode' type: #sqLong> + "Set primFailCode primitive failure and associated secondaryErrorCode." + <api> + secondaryErrorCode := extraErrorCode. + ^primFailCode := reasonCode! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFailForFFIException:at: (in category 'primitive support') ----- primitiveFailForFFIException: exceptionCode at: pc <var: 'exceptionCode' type: #usqLong> <var: 'pc' type: #usqInt> "Set PrimErrFFIException primitive failure and associated exceptionCode (a.k.a. + secondaryErrorCode) and exceptionPC. Under control of the ffiExceptionResponse flag, - osErrorCode) and exceptionPC. Under control of the ffiExceptionResponse flag, if in a primitive with an error code and the inFFIFlags indicate we're in an FFI call, then fail the primitive. ffiExceptionResponse < 0 never fail ffiExceptionResponse = 0 fail if method has a primitive error code (default) ffiExceptionResponse > 0 always fail" <api> ((inFFIFlags noMask: DisownVMForFFICall) "i.e. not in an FFI call" or: [ffiExceptionResponse < 0]) ifTrue: "i.e. never fail" [^self]. + secondaryErrorCode := self cCoerceSimple: exceptionCode to: #sqLong. - osErrorCode := self cCoerceSimple: exceptionCode to: #sqLong. exceptionPC := pc. primFailCode := PrimErrFFIException. (ffiExceptionResponse > 0 "always fail..." or: [(objectMemory isOopCompiledMethod: newMethod) and: [self methodUsesPrimitiveErrorCode: newMethod]]) ifTrue: [self ownVM: DisownVMForFFICall. "To take ownership but importantly to reset inFFIFlags" self activateFailingPrimitiveMethod]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFailForOSError: (in category 'primitive support') ----- + primitiveFailForOSError: osErrorCode + <var: 'osErrorCode' type: #sqLong> - primitiveFailForOSError: osError - <var: 'osError' type: #sqLong> "Set PrimErrOSError primitive failure and associated osErrorCode." <api> + secondaryErrorCode := osErrorCode. - osErrorCode := osError. ^primFailCode := PrimErrOSError! Item was added: + ----- Method: NewObjectMemory>>printCantBeObject:on: (in category 'debug printing interpreter support') ----- + printCantBeObject: oop on: aStream + <var: 'aStream' type: #'FILE *'> + '16r%lx%s\n' + f: aStream + printf: {oop. + ((oop bitAnd: self allocationUnit - 1) ~= 0 + ifTrue: [' is misaligned'] + ifFalse: [coInterpreter whereIs: oop])}! Item was removed: - ----- Method: NewObjectMemory>>printHeaderTypeOf: (in category 'debug printing') ----- - printHeaderTypeOf: obj - (self headerType: obj) caseOf: { - [HeaderTypeFree] -> [coInterpreter print: ' HeaderTypeFree (4 bytes)']. - [HeaderTypeShort] -> [coInterpreter print: ' HeaderTypeShort (4 bytes)']. - [HeaderTypeClass] -> [coInterpreter print: ' HeaderTypeClass (8 bytes)']. - [HeaderTypeSizeAndClass] -> [coInterpreter print: ' HeaderTypeSizeAndClass (12 bytes)'] }! Item was added: + ----- Method: NewObjectMemory>>printHeaderTypeOf:on: (in category 'debug printing interpreter support') ----- + printHeaderTypeOf: obj on: aStream + <var: 'aStream' type: #'FILE *'> + <inline: true> + (self headerType: obj) caseOf: { + [HeaderTypeFree] -> [aStream printf: ' HeaderTypeFree (4 bytes)']. + [HeaderTypeShort] -> [aStream printf: ' HeaderTypeShort (4 bytes)']. + [HeaderTypeClass] -> [aStream printf: ' HeaderTypeClass (8 bytes)']. + [HeaderTypeSizeAndClass] -> [aStream printf: ' HeaderTypeSizeAndClass (12 bytes)'] }! Item was changed: + ----- Method: NewObjectMemory>>safePrintStringOf: (in category 'debug printing interpreter support') ----- - ----- Method: NewObjectMemory>>safePrintStringOf: (in category 'debug printing') ----- safePrintStringOf: oop "Version of printStringOf: that copes with forwarding during garbage collection." | fmt header cnt i | <inline: false> (self isIntegerObject: oop) ifTrue: [^nil]. (self oop: oop isGreaterThanOrEqualTo: self startOfMemory andLessThan: freeStart) ifFalse: [^nil]. (oop bitAnd: (self wordSize - 1)) ~= 0 ifTrue: [^nil]. header := self headerWhileForwardingOf: oop. fmt := self formatOfHeader: header. fmt < 8 ifTrue: [ ^nil ]. cnt := 100 min: (self lengthOf: oop baseHeader: header format: fmt). i := 0. [i < cnt] whileTrue: [self printChar: (self fetchByte: i ofObject: oop). i := i + 1]. coInterpreter flush. ^oop! Item was changed: + ----- Method: NewObjectMemory>>whereIsMaybeHeapThing: (in category 'debug printing interpreter support') ----- - ----- Method: NewObjectMemory>>whereIsMaybeHeapThing: (in category 'debug printing') ----- whereIsMaybeHeapThing: anOop <returnTypeC: 'char *'> (self oop: anOop isGreaterThanOrEqualTo: self startOfMemory andLessThan: endOfMemory) ifTrue: [(self oop: anOop isLessThan: freeStart) ifTrue: [^' is in old space']. (self oop: anOop isLessThan: reserveStart) ifTrue: [^' is in new space']. ^' is above reserve start']. ^nil! Item was changed: + ----- Method: NullStream>>crtab (in category '*VMMaker-debug printing interpreter support') ----- - ----- Method: NullStream>>crtab (in category '*VMMaker-translation support') ----- crtab! Item was added: + ----- Method: NullStream>>fputc: (in category '*VMMaker-debug printing interpreter support') ----- + fputc: aCharacterOrCode! Item was added: + ----- Method: ObjectMemory>>printCantBeObject:on: (in category 'debug printing interpreter support') ----- + printCantBeObject: oop on: aStream + <var: 'aStream' type: #'FILE *'> + '16r%lx%s\n' + f: aStream + printf: {oop. + ((oop bitAnd: self allocationUnit - 1) ~= 0 + ifTrue: [' is misaligned'] + ifFalse: [self whereIs: oop])}! Item was added: + ----- Method: ObjectMemory>>printFreeObject:on: (in category 'debug printing') ----- + printFreeObject: oop on: aStream + <var: 'aStream' type: #'FILE *'> + '16r%lx is a free chunk of size %ld\n' + f: aStream + printf: {oop. self sizeOfFree: oop}! Item was added: + ----- Method: ObjectMemory>>printImmediateObject:on: (in category 'debug printing interpreter support') ----- + printImmediateObject: oop on: aStream + <var: 'aStream' type: #'FILE *'> + self assert: (self isIntegerObject: oop). + '16r%lx=%ld\n' f: aStream printf: {oop. (self integerValueOf: oop) asInteger}! Item was added: + ----- Method: ObjectMemory>>printNonPointerDataOf:on: (in category 'debug printing interpreter support') ----- + printNonPointerDataOf: oop on: aStream + <var: 'aStream' type: #'FILE *'> + | elementsPerLine format lastIndex sixteenSpaces | + format := self formatOf: oop. + self assert: (format between: self sixtyFourBitIndexableFormat and: self firstCompiledMethodFormat - 1). + lastIndex := self lengthOf: oop format: format. + lastIndex = 0 ifTrue: + [^self]. + sixteenSpaces := ' '. + format = self sixtyFourBitIndexableFormat ifTrue: + [lastIndex := 32 min: lastIndex. + elementsPerLine := 4. "0x/16r0123456789ABCDEF<space|cr> x 4 = 76/80" + 1 to: lastIndex do: + [:index| | v64 | + v64 := self cCoerceSimple: (self fetchLong64: index - 1 ofObject: oop) to: #usqLong. + '%.*s16r%lx%c' f: aStream printf: { + 64 - (v64 highBit max: 1) // 4. + sixteenSpaces. + v64. + (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| | v16 | + v16 := self fetchShort16: index - 1 ofObject: oop. + '%.*s16r%lx%c' f: aStream printf: { + 16 - (v16 highBit max: 1) // 4. + sixteenSpaces. + v16. + (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| | v8 | + v8 := self fetchByte: index - 1 ofObject: oop. + '%.*s16r%lx%c' f: aStream printf: { + 8 - (v8 highBit max: 1) // 4. + sixteenSpaces. + v8. + (index \\ elementsPerLine = 0 or: [index = lastIndex]) + ifTrue: [Character cr] ifFalse: [Character space] }]! Item was added: + ----- Method: ObjectMemory>>printStringDataOf:on: (in category 'debug printing interpreter support') ----- + printStringDataOf: oop on: aStream + <var: 'aStream' type: #'FILE *'> + | i limit n | + (self isBytesNonImm: oop) + ifTrue: + [| buffer byte | + buffer := self alloca: 256 * 4. + n := i := 0. + limit := (self numBytesOfBytes: oop) min: 256. + [i < limit] whileTrue: + [byte := self fetchByte: i ofObject: oop. + (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 *'. + n := i := 0. + limit := (self lengthOf: oop) min: 256. + [i < limit] whileTrue: + [word := self fetchLong32: i ofObject: oop. + (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' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]! Item was changed: + ----- Method: ObjectMemory>>safePrintStringOf: (in category 'debug printing interpreter support') ----- - ----- Method: ObjectMemory>>safePrintStringOf: (in category 'debug printing') ----- safePrintStringOf: oop "Version of printStringOf: that copes with forwarding during garbage collection." | fmt header cnt i | <inline: false> (self isIntegerObject: oop) ifTrue: [^nil]. (self oop: oop isGreaterThanOrEqualTo: self startOfMemory andLessThan: freeBlock) ifFalse: [^nil]. (oop bitAnd: (self wordSize - 1)) ~= 0 ifTrue: [^nil]. header := self headerWhileForwardingOf: oop. fmt := self formatOfHeader: header. fmt < self firstByteFormat ifTrue: [^nil]. cnt := 100 min: (self lengthOf: oop baseHeader: header format: fmt). i := 0. [i < cnt] whileTrue: [self printChar: (self fetchByte: i ofObject: oop). i := i + 1]. self flush. ^oop! Item was changed: + ----- Method: ObjectMemory>>whereIsMaybeHeapThing: (in category 'debug printing interpreter support') ----- - ----- Method: ObjectMemory>>whereIsMaybeHeapThing: (in category 'debug printing') ----- whereIsMaybeHeapThing: anOop <returnTypeC: 'char *'> (self oop: anOop isGreaterThanOrEqualTo: self startOfMemory andLessThan: endOfMemory) ifTrue: [(self oop: anOop isLessThan: freeBlock) ifTrue: [^' is in old space']. ^' is in new space']. ^nil! Item was changed: ----- Method: PrintfNumberFormatDescriptor>>transformForVMMaker (in category '*VMMaker-C code generation') ----- transformForVMMaker + ('duxX' includes: operator) ifTrue: + [^'%" PRI', (String with: operator), 'SQINT "']. + ('pP' includes: operator) ifTrue: + [^'%" PRI', (String with: (operator = $p ifTrue: [$x] ifFalse: [$X])), 'SQPTR "']. + ^super transformForVMMaker! - ('duxX' includes: operator) ifFalse: - [^super transformForVMMaker]. - ^'%" PRI', (String with: operator), 'SQINT "'! Item was changed: ----- Method: Spur32BitMMLECoSimulator>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect "If we're /not/ a clone, clone the VM and push it over the cliff. If it survives, destroy the clone and continue. We should be OK until next time." parent ifNil: + [coInterpreter cr; print: 'GC number '; printNum: statFullGCs; tab; flush. - [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush. CloneOnGC ifTrue: [coInterpreter cloneSimulation objectMemory globalGarbageCollect. Smalltalk garbageCollect]]. ^super globalGarbageCollect! Item was changed: ----- Method: Spur32BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect "If we're /not/ a clone, clone the VM and push it over the cliff. If it survives, destroy the clone and continue. We should be OK until next time." parent ifNil: + [coInterpreter cr; print: 'GC number '; printNum: statFullGCs; tab; flush. - [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush. CloneOnGC ifTrue: [coInterpreter cloneSimulation objectMemory globalGarbageCollect. Smalltalk garbageCollect]]. ^super globalGarbageCollect! Item was changed: ----- Method: Spur64BitMMLECoSimulator>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect "If we're /not/ a clone, clone the VM and push it over the cliff. If it survives, destroy the clone and continue. We should be OK until next time." parent ifNil: + [coInterpreter cr; print: 'GC number '; printNum: statFullGCs; tab; flush. - [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush. CloneOnGC ifTrue: [coInterpreter cloneSimulation objectMemory globalGarbageCollect. Smalltalk garbageCollect]]. ^super globalGarbageCollect! Item was changed: ----- Method: Spur64BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect "If we're /not/ a clone, clone the VM and push it over the cliff. If it survives, destroy the clone and continue. We should be OK until next time." parent ifNil: + [coInterpreter cr; print: 'GC number '; printNum: statFullGCs; tab; flush. - [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush. CloneOnGC ifTrue: [coInterpreter cloneSimulation objectMemory globalGarbageCollect. Smalltalk garbageCollect]]. ^super globalGarbageCollect! Item was added: + ----- Method: SpurMemoryManager>>printCantBeObject:on: (in category 'debug printing interpreter support') ----- + printCantBeObject: oop on: aStream + <var: 'aStream' type: #'FILE *'> + ((oop bitAnd: self allocationUnit - 1) = 0 + and: [(self isInNewSpace: oop) + and: [self isForwarded: oop]]) ifTrue: + [^self printForwarder: oop on: aStream]. + '16r%lx%s\n' + f: aStream + printf: {oop. + ((oop bitAnd: self allocationUnit - 1) ~= 0 + ifTrue: [' is misaligned'] + ifFalse: [coInterpreter whereIs: oop])}! Item was added: + ----- Method: SpurMemoryManager>>printForwarder:on: (in category 'debug printing interpreter support') ----- + printForwarder: oop on: aStream + <var: 'aStream' type: #'FILE *'> + '16r%lx is a forwarded hdr%d slot size %ud object to 16r%lx\n' + f: aStream + printf: { oop. + (self rawNumSlotsOf: oop) = self numSlotsMask ifTrue: [16] ifFalse: [8]. + self numSlotsOfAny: oop. + self objectMemory followForwarded: oop}! Item was added: + ----- Method: SpurMemoryManager>>printFreeObject:on: (in category 'debug printing') ----- + printFreeObject: oop on: aStream + <var: 'aStream' type: #'FILE *'> + '16r%lx is a free chunk of size %ld 0th field:16r%lx\n' + f: aStream + printf: {oop. self bytesInBody: oop. self fetchPointer: 0 ofFreeChunk: oop }! Item was removed: - ----- Method: SpurMemoryManager>>printHeaderTypeOf: (in category 'debug printing') ----- - printHeaderTypeOf: objOop - coInterpreter - print: ((self numSlotsOfAny: objOop) >= self numSlotsMask - ifTrue: [' hdr16 '] - ifFalse: [' hdr8 ']); - printChar: ((self isImmutable: objOop) ifTrue: [$i] ifFalse: [$.]); - printChar: ((self isRemembered: objOop) ifTrue: [$r] ifFalse: [$.]); - printChar: ((self isPinned: objOop) ifTrue: [$p] ifFalse: [$.]); - printChar: ((self isMarked: objOop) ifTrue: [$m] ifFalse: [$.]); - printChar: ((self isGrey: objOop) ifTrue: [$g] ifFalse: [$.])! Item was added: + ----- Method: SpurMemoryManager>>printHeaderTypeOf:on: (in category 'debug printing interpreter support') ----- + printHeaderTypeOf: obj on: aStream + <var: 'aStream' type: #'FILE *'> + <inline: true> + ' hdr%d %c%c%c%c%c' f: aStream printf: { + (self rawNumSlotsOf: obj) = self numSlotsMask ifTrue: [16] ifFalse: [8]. + (self isImmutable: obj) ifTrue: [$i] ifFalse: [$.]. + (self isRemembered: obj) ifTrue: [$r] ifFalse: [$.]. + (self isPinned: obj) ifTrue: [$p] ifFalse: [$.]. + (self isMarked: obj) ifTrue: [$m] ifFalse: [$.]. + (self isGrey: obj) ifTrue: [$g] ifFalse: [$.] }! Item was added: + ----- Method: SpurMemoryManager>>printImmediateObject:on: (in category 'debug printing interpreter support') ----- + printImmediateObject: oop on: aStream + <var: 'aStream' type: #'FILE *'> + self assert: (self isImmediate: oop). + (self isIntegerObject: oop) ifTrue: + ['16r%lx=%ld\n' f: aStream printf: {oop. (self integerValueOf: oop) asInteger}]. + (self isImmediateCharacter: oop) ifTrue: + ['16r%lx=$%ld ($%lc)\n' f: aStream printf: {oop. + (self characterValueOf: oop) asLong. + self cCoerce: (self characterValueOf: oop) to: 'wint_t'}]. + (self isImmediateFloat: oop) ifTrue: + ['16r%lx=%g\n' f: aStream printf: {oop. self floatValueOf: oop}]! Item was added: + ----- Method: SpurMemoryManager>>printNonPointerDataOf:on: (in category 'debug printing interpreter support') ----- + printNonPointerDataOf: oop on: aStream + <var: 'aStream' type: #'FILE *'> + | elementsPerLine format lastIndex sixteenSpaces | + format := self formatOf: oop. + self assert: (format between: self sixtyFourBitIndexableFormat and: self firstCompiledMethodFormat - 1). + lastIndex := self lengthOf: oop format: format. + lastIndex = 0 ifTrue: + [^self]. + sixteenSpaces := ' '. + format = self sixtyFourBitIndexableFormat ifTrue: + [lastIndex := 32 min: lastIndex. + elementsPerLine := 4. "0x/16r0123456789ABCDEF<space|cr> x 4 = 76/80" + 1 to: lastIndex do: + [:index| | v64 | + v64 := self cCoerceSimple: (self fetchLong64: index - 1 ofObject: oop) to: #usqLong. + '%.*s16r%lx%c' f: aStream printf: { + 64 - (v64 highBit max: 1) // 4. + sixteenSpaces. + v64. + (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| | v32 | + v32 := self cCoerceSimple: (self fetchLong32: index - 1 ofObject: oop) to: #unsigned. + '%.*s16r%lx%c' f: aStream printf: { + 32 - (v32 highBit max: 1) // 4. + sixteenSpaces. + v32. + (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| | v16 | + v16 := self fetchShort16: index - 1 ofObject: oop. + '%.*s16r%lx%c' f: aStream printf: { + 16 - (v16 highBit max: 1) // 4. + sixteenSpaces. + v16. + (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| | v8 | + v8 := self fetchByte: index - 1 ofObject: oop. + '%.*s16r%lx%c' f: aStream printf: { + 8 - (v8 highBit max: 1) // 4. + sixteenSpaces. + v8. + (index \\ elementsPerLine = 0 or: [index = lastIndex]) + ifTrue: [Character cr] ifFalse: [Character space] }]! Item was changed: ----- Method: SpurMemoryManager>>printObjectsWithHash: (in category 'debug printing') ----- printObjectsWithHash: hash "Scan the heap printing the oops of any and all objects whose hash equals the argument." <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" self allHeapEntitiesDo: [:obj| (self rawHashBitsOf: obj) = hash ifTrue: + [coInterpreter shortPrintOop: obj]]! - [coInterpreter shortPrintOop: obj; cr]]! Item was added: + ----- Method: SpurMemoryManager>>printStringDataOf:on: (in category 'debug printing interpreter support') ----- + printStringDataOf: oop on: aStream + <var: 'aStream' type: #'FILE *'> + | i limit n | + <var: 'buffer' type: #'char *'> + <var: 'wideBuffer' type: #'unsigned int *'> + (self isBytesNonImm: oop) + ifTrue: + [| buffer byte | + buffer := self alloca: 256 * 4. + n := i := 0. + limit := (self numBytesOfBytes: oop) min: 256. + [i < limit] whileTrue: + [byte := self fetchByte: i ofObject: oop. + (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 *'. + n := i := 0. + limit := (self lengthOf: oop) min: 256. + [i < limit] whileTrue: + [word := self fetchLong32: i ofObject: oop. + (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' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]! Item was changed: + ----- Method: SpurMemoryManager>>safePrintStringOf: (in category 'debug printing interpreter support') ----- - ----- Method: SpurMemoryManager>>safePrintStringOf: (in category 'debug printing') ----- safePrintStringOf: oop | target | (self isOopForwarded: oop) ifTrue: [target := self followForwarded: oop] ifFalse: [target := oop]. ^coInterpreter printStringOf: target! Item was changed: + ----- Method: SpurMemoryManager>>whereIsMaybeHeapThing: (in category 'debug printing interpreter support') ----- - ----- Method: SpurMemoryManager>>whereIsMaybeHeapThing: (in category 'debug printing') ----- whereIsMaybeHeapThing: anOop <returnTypeC: 'char *'> (self isInNewSpace: anOop) ifTrue: [(self isInEden: anOop) ifTrue: [^' is in eden']. (self isInFutureSpace: anOop) ifTrue: [^' is in future space']. (self isInPastSpace: anOop) ifTrue: [^' is in past space']. ^' is in new space']. (self isInOldSpace: anOop) ifTrue: [(segmentManager segmentContainingObj: anOop) ifNotNil: [^' is in old space']. ^' is between old space segments']. ^nil! Item was changed: ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator | vmClass | self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses" vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter" aCCodeGenerator addHeaderFile: '<stdio.h> /* for printf */'; addHeaderFile: '<stdlib.h> /* for e.g. alloca */'; addHeaderFile: '<setjmp.h>'; addHeaderFile: '<wchar.h> /* for wint_t */'; addHeaderFile: '"vmCallback.h"'; addHeaderFile: '"sqMemoryFence.h"'; addHeaderFile: '"sqImageFileAccess.h"'; addHeaderFile: '"sqSetjmpShim.h"'; addHeaderFile: '"dispdbg.h"'. LowcodeVM ifTrue: [aCCodeGenerator addHeaderFile: '"sqLowcodeFFI.h"']. vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'. aCCodeGenerator var: #interpreterProxy type: #'struct VirtualMachine*'. aCCodeGenerator declareVar: #sendTrace type: 'volatile int'; declareVar: #byteCount type: #usqLong. "see dispdbg.h" "These need to be pointers or unsigned." self declareC: #(instructionPointer method newMethod) as: #usqInt in: aCCodeGenerator. "These are all pointers; char * because Slang has no support for C pointer arithmetic." self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit breakSelector) as: #'char *' in: aCCodeGenerator. aCCodeGenerator var: #breakSelectorLength declareC: 'sqInt breakSelectorLength = MinSmallInteger'. self declareC: #(stackPage overflowedPage) as: #'StackPage *' in: aCCodeGenerator. + aCCodeGenerator + var: #transcript type: #'FILE *'. aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code." "This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS is not defined, for the benefit of the interpreter on slow machines." aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS). MULTIPLEBYTECODESETS == false ifTrue: [aCCodeGenerator removeVariable: 'bytecodeSetSelector']. BytecodeSetHasExtensions == false ifTrue: [aCCodeGenerator removeVariable: 'extA'; removeVariable: 'extB']. aCCodeGenerator var: #methodCache declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'. NewspeakVM ifTrue: [aCCodeGenerator var: #nsMethodCache declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]'] ifFalse: [aCCodeGenerator removeVariable: #nsMethodCache; removeVariable: 'localAbsentReceiver'; removeVariable: 'localAbsentReceiverOrZero']. AtCacheTotalSize isInteger ifTrue: [aCCodeGenerator var: #atCache declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]']. aCCodeGenerator var: #primitiveTable declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString. vmClass primitiveTable do: [:symbolOrNot| (symbolOrNot isSymbol and: [symbolOrNot ~~ #primitiveFail]) ifTrue: [(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil: [:tMethod| tMethod returnType: #void]]]. vmClass objectMemoryClass hasSpurMemoryManagerAPI ifTrue: [aCCodeGenerator var: #primitiveAccessorDepthTable type: 'signed char' sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */' array: vmClass primitiveAccessorDepthTable] ifFalse: [aCCodeGenerator removeVariable: #primitiveAccessorDepthTable]. aCCodeGenerator + var: #displayBits type: #'void *'; + var: #primitiveCalloutPointer declareC: 'void *primitiveCalloutPointer = (void *)-1'. - var: #displayBits type: #'void *'. self declareC: #(displayWidth displayHeight displayDepth) as: #int in: aCCodeGenerator. aCCodeGenerator var: #primitiveFunctionPointer declareC: 'void (*primitiveFunctionPointer)()'; var: #externalPrimitiveTable declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'; var: #interruptCheckChain declareC: 'void (*interruptCheckChain)(void) = 0'; var: #showSurfaceFn declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)'; var: #jmpBuf declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'; var: #suspendedCallbacks declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'; var: #suspendedMethods declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs "these are high-frequency enough that they're overflowing quite quickly on modern hardware" statProcessSwitch statIOProcessEvents statForceInterruptCheck statCheckForEvents statStackOverflow statStackPageDivorce statIdleUsecs) in: aCCodeGenerator. aCCodeGenerator var: #nextProfileTick type: #sqLong. aCCodeGenerator var: #reenterInterpreter type: 'jmp_buf'. LowcodeVM ifTrue: [aCCodeGenerator var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*'. self declareC: #(nativeSP nativeStackPointer shadowCallStackPointer) as: #'char *' in: aCCodeGenerator] ifFalse: [#(lowcodeCalloutState nativeSP nativeStackPointer shadowCallStackPointer) do: + [:var| aCCodeGenerator removeVariable: var]]! - [:var| aCCodeGenerator removeVariable: var]]. - - aCCodeGenerator - var: #primitiveDoMixedArithmetic - declareC: 'char primitiveDoMixedArithmetic = 1'.! Item was changed: ----- Method: StackInterpreter>>abstractDetailedSymbolicMethod: (in category 'debug support') ----- abstractDetailedSymbolicMethod: aMethod <doNotGenerate> + | prim | + transcript ensureCr. - | ts prim | - (ts := self transcript) ensureCr. (prim := self primitiveIndexOf: aMethod) > 0 ifTrue: + [transcript nextPutAll: '<primitive: '; print: prim; nextPut: $>. - [ts nextPutAll: '<primitive: '; print: prim; nextPut: $>. (self isQuickPrimitiveIndex: prim) ifTrue: + [transcript nextPutAll: ' quick method'; cr; flush. - [ts nextPutAll: ' quick method'; cr; flush. ^self]. + transcript cr]. - ts cr]. (RelativeDetailedInstructionPrinter on: (VMCompiledMethodProxy new for: aMethod coInterpreter: self objectMemory: objectMemory)) indent: 0; + printInstructionsOn: transcript. + transcript flush! - printInstructionsOn: ts. - ts flush! Item was changed: ----- Method: StackInterpreter>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') ----- codeGeneratorToComputeAccessorDepth ^(VMMaker new buildCodeGeneratorForInterpreter: self class primitivesClass includeAPIMethods: false initializeClasses: false) + logger: transcript; - logger: self transcript; yourself! Item was changed: ----- Method: StackInterpreter>>cr (in category 'debug printing') ----- cr + "Append a newline to transcript. + This is a bit weird because, at least for me, fputc has its parameters backwards..." + <cmacro: '() fputc(''\n'',transcript)'> + transcript fputc: Character cr! - "For testing in Smalltalk, this method should be overridden in a subclass." - <inline: true> - self printf: '\n'! Item was changed: ----- Method: StackInterpreter>>detailedSymbolicMethod: (in category 'debug support') ----- detailedSymbolicMethod: aMethod <doNotGenerate> + transcript - self transcript ensureCr; nextPutAll: ((String streamContents: [:ts| | prim proxy | (prim := self primitiveIndexOf: aMethod) > 0 ifTrue: [ts nextPutAll: '<primitive: '; print: prim; nextPut: $>. (self isQuickPrimitiveIndex: prim) ifTrue: [ts nextPutAll: ' quick method'; cr; flush. ^self]. ts cr]. proxy := VMCompiledMethodProxy new for: aMethod coInterpreter: self objectMemory: objectMemory. (DetailedInstructionPrinter on: proxy) stackHeightComputer: (StackDepthFinder on: proxy); indent: 0; printInstructionsOn: ts]) copyReplaceAll: 'a VMObjectProxy for ' with: ''); flush! Item was changed: ----- Method: StackInterpreter>>flush (in category 'debug printing') ----- flush <api> + <inline: true> + transcript fflush! - <cmacro: '() fflush(stdout)'>! Item was added: + ----- Method: StackInterpreter>>getTranscript (in category 'debug printing redirected') ----- + getTranscript + <api> + <returnTypeC: #'FILE *'> + ^transcript! Item was changed: ----- Method: StackInterpreter>>initialize (in category 'initialization') ----- initialize "Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated." super initialize. + primitiveDoMixedArithmetic := true. "whether we authorize primitives to perform mixed arithmetic or not". + newFinalization := false. - primitiveDoMixedArithmetic := true. "whether we authorize primitives to perform mixed arithmetic or not" stackLimit := 0. "This is also the initialization flag for the stack system." stackPage := overflowedPage := 0. extraFramesToMoveOnOverflow := 0. bytecodeSetSelector := 0. highestRunnableProcessPriority := 0. nextPollUsecs := 0. nextWakeupUsecs := 0. tempOop := tempOop2 := theUnknownShort := 0. interruptPending := false. inIOProcessEvents := 0. fullScreenFlag := 0. sendWheelEvents := deferDisplayUpdates := false. displayBits := displayWidth := displayHeight := displayDepth := 0. pendingFinalizationSignals := statPendingFinalizationSignals := 0. globalSessionID := 0. jmpDepth := 0. maxExtSemTabSizeSet := false. debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0. + primitiveCalloutPointer := -1. "initialized in declaration in declareCVarsIn:" + transcript := Transcript. "initialized to stdout in readImageFromFile:HeapSize:StartingAt:" statForceInterruptCheck := statStackOverflow := statCheckForEvents := statProcessSwitch := statIOProcessEvents := statStackPageDivorce := statIdleUsecs := 0! Item was changed: ----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') ----- initializeInterpreter: bytesToShift "Initialize Interpreter state before starting execution of a new image." interpreterProxy := self sqGetInterpreterProxy. self dummyReferToProxy. objectMemory initializeObjectMemory: bytesToShift. self checkAssumedCompactClasses. self initializeExtraClassInstVarIndices. method := newMethod := objectMemory nilObject. self cCode: '' inSmalltalk: [breakSelectorLength ifNil: [breakSelectorLength := objectMemory minSmallInteger]. breakLookupClassTag ifNil: [breakLookupClassTag := -1]. reenterInterpreter := ReenterInterpreter new]. methodDictLinearSearchLimit := 8. self initialCleanup. + primitiveDoMixedArithmetic := true. LowcodeVM ifTrue: [ self setupNativeStack ]. profileSemaphore := profileProcess := profileMethod := objectMemory nilObject. self cCode: '' inSmalltalk: [InitializationOptions at: #profiling ifPresent: [:profiling| "hack turn on profiling, for testing in the simulator." profiling ifTrue: [profileSemaphore := objectMemory cloneObject: (objectMemory splObj: TheInterruptSemaphore). objectMemory storePointerUnchecked: FirstLinkIndex ofObject: profileSemaphore withValue: objectMemory nilObject; storePointerUnchecked: NextLinkIndex ofObject: profileSemaphore withValue: objectMemory nilObject; storePointerUnchecked: ExcessSignalsIndex ofObject: profileSemaphore withValue: (objectMemory integerObjectOf: 0)]]]. interruptKeycode := 2094. "cmd-. as used for Mac but no other OS" [globalSessionID = 0] whileTrue: [globalSessionID := self cCode: [((self time: #NULL) + self ioMSecs) bitAnd: 16r7FFFFFFF] inSmalltalk: [(Random new next * (SmallInteger maxVal min: 16r7FFFFFFF)) asInteger]]. metaAccessorDepth := -2. super initializeInterpreter: bytesToShift! Item was changed: ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') ----- longPrintOop: oop <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" + | fmt lastIndex startIP column cls | - | fmt lastIndex startIP bytecodesPerLine column | <var: 'field16' type: #'unsigned short'> <var: 'field32' type: #'unsigned int'> <var: 'field64' type: #usqLong> + + (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: ['16r%lx has a nil class!!!!\n' f: transcript printf: oop] + ifNotNil: + [| className length | + className := self nameOfClass: cls lengthInto: (self addressOf: length put: [:v| length := v]). + '16r%lx: a(n) %.*s' f: transcript printf: {oop. length. className }. - ((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. - ^self]. - self printHex: oop. - (objectMemory fetchClassOfNonImm: oop) - ifNil: [self print: ' has a nil class!!!!'] - ifNotNil: [:class| - self print: ': a(n) '; printNameOfClass: class count: 5; - print: ' ('. objectMemory hasSpurMemoryManagerAPI ifTrue: + ['(%lx=>16r%lx)' f: transcript printf: { objectMemory compactClassIndexOf: oop. cls }]]. - [self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>']. - self printHexnp: class; print: ')']. fmt := objectMemory formatOf: oop. + ' format %lx' f: transcript printf: fmt. - self print: ' format '; printHexnp: fmt. fmt > objectMemory lastPointerFormat + ifTrue: [' nbytes %ld' f: transcript printf: (objectMemory numBytesOf: oop)] - ifTrue: [self print: ' nbytes '; printNum: (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: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]]. - objectMemory printHeaderTypeOf: oop. self print: ' hash '; printHexnp: (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) asUnsignedInteger }]. + (self is: oop KindOfClass: (self superclassOf: (objectMemory splObj: ClassString))) ifTrue: + [^objectMemory printStringDataOf: oop on: transcript]. + ^objectMemory printNonPointerDataOf: oop on: transcript]. - (fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: - [^self printStringOf: oop; cr]. - (fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue: - [0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do: - [:i| | field32 | - field32 := objectMemory fetchLong32: i ofObject: oop. - self space; printNum: i; space; printHex: field32; space; cr]. - ^self]. - objectMemory hasSpurMemoryManagerAPI ifTrue: - [fmt = objectMemory sixtyFourBitIndexableFormat ifTrue: - [0 to: ((objectMemory num64BitUnitsOf: oop) min: 256) - 1 do: - [:i| | field64 | - field64 := objectMemory fetchLong64: i ofObject: oop. - self space; printNum: i; space; printHex: field64; space; cr]. - ^self]. - (fmt between: objectMemory firstShortFormat and: objectMemory firstShortFormat + 1) ifTrue: - [0 to: ((objectMemory num16BitUnitsOf: oop) min: 256) - 1 do: - [:i| | field16 | - field16 := objectMemory fetchShort16: i ofObject: oop. - self space; printNum: i; space; printHex: field16; space; cr]. - ^self]]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory 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 printOopShortInner: fieldOop]. - ifFalse: [self cCode: [self printOopShort: fieldOop] - inSmalltalk: [self print: (self shortPrint: fieldOop)]]. self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > lastIndex ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * objectMemory wordSize + 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: + ['16r%08p: ' f: transcript printf: (oop + BaseHeaderSize + index - 1) asVoidPointer]. - [self cCode: 'printf("0x%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))' - inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']]. 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]]. + (column between: 2 and: 7) ifTrue: - self cCode: 'printf(" %02x/%-3d", (int)byte,(int)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 added: + ----- Method: StackInterpreter>>nameOfClass:lengthInto: (in category 'debug printing') ----- + nameOfClass: classOop lengthInto: lengthPtr + "Brain-damaged nameOfClass: for C VM. Does *not* answer Foo class for metaclasses. + Use e.g. classIsMeta: to avoid being fooled." + <returnTypeC: #'char *'> + <var: 'lengthPtr' type: 'sqInt *'> + <inline: false> + | numSlots maybeNameOop maybeThisClassOop | + numSlots := objectMemory numSlotsOf: classOop. + numSlots = metaclassNumSlots ifTrue: + [maybeThisClassOop := objectMemory fetchPointer: thisClassIndex ofObject: classOop. + (self addressCouldBeClassObj: maybeThisClassOop) ifTrue: + [^self nameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop) lengthInto: lengthPtr]. + lengthPtr at: 0 put: 9. + ^'bad class']. + (numSlots > classNameIndex + and: [maybeNameOop := objectMemory fetchPointer: classNameIndex ofObject: classOop. + objectMemory isBytes: maybeNameOop]) ifTrue: + [lengthPtr at: 0 put: (objectMemory numBytesOfBytes: maybeNameOop). + ^objectMemory firstIndexableField: maybeNameOop]. + lengthPtr at: 0 put: 9. + ^'bad class'! Item was changed: ----- Method: StackInterpreter>>print: (in category 'debug printing') ----- print: s - "For testing in Smalltalk, this method should be overridden in a subclass." <api> <var: #s type: #'char *'> + transcript fprintf: s! - self cCode: 'fputs(s, stdout)'! Item was changed: ----- Method: StackInterpreter>>printActivationNameFor:receiver:isBlock:firstTemporary: (in category 'debug printing') ----- printActivationNameFor: aMethod receiver: anObject isBlock: isBlock firstTemporary: maybeMessage | methClass methodSel classObj | <inline: false> isBlock ifTrue: [self print: '[] in ']. methClass := self findClassOfMethod: aMethod forReceiver: anObject. methodSel := self findSelectorOfMethod: aMethod. ((objectMemory addressCouldBeOop: anObject) and: [(objectMemory isOopForwarded: anObject) not and: [self addressCouldBeClassObj: (classObj := objectMemory fetchClassOf: anObject)]]) ifTrue: [(classObj = methClass or: [methClass isNil or: [methClass = objectMemory nilObject] "i.e. doits"]) ifTrue: [self printNameOfClass: classObj count: 5] ifFalse: [self printNameOfClass: classObj count: 5. + self printChar: $(. - self print: '('. self printNameOfClass: methClass count: 5. + self printChar: $)]] - self print: ')']] ifFalse: [self print: 'INVALID RECEIVER']. + self printChar: $>. - self print: '>'. (objectMemory addressCouldBeOop: methodSel) ifTrue: [methodSel = objectMemory nilObject ifTrue: [self print: '(nil)'] ifFalse: [self printStringOf: methodSel]] ifFalse: [self print: 'INVALID SELECTOR']. (methodSel = (objectMemory splObj: SelectorDoesNotUnderstand) and: [(objectMemory addressCouldBeObj: maybeMessage) and: [(objectMemory fetchClassOfNonImm: maybeMessage) = (objectMemory splObj: ClassMessage)]]) ifTrue: ["print arg message selector" methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: maybeMessage. + self space. - self print: ' '. self printStringOf: methodSel]! Item was added: + ----- Method: StackInterpreter>>printAllStacksOn: (in category 'debug printing redirected') ----- + printAllStacksOn: aStdioStream + "Print all the stacks of all running processes, including those that are currently suspended." + <export: true> "essential for writing crash.dmp; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" + <var: 'aStdioStream' type: #'FILE *'> + self withRedirectedOutputTo: aStdioStream do: [self printAllStacks]! Item was changed: ----- Method: StackInterpreter>>printAtCache (in category 'debug printing') ----- printAtCache 0 to: AtCacheTotalSize - 1 by: 4 do: [:i | | obj sz fmt fixed | obj := atCache at: i + AtCacheOop. sz := atCache at: i + AtCacheSize. fmt := atCache at: i + AtCacheFmt. fixed := atCache at: i + AtCacheFixedFields. (objectMemory addressCouldBeObj: obj) ifTrue: + [transcript ensureCr. - [self transcript ensureCr. self print: i; tab; print: (i < AtPutBase ifTrue: ['at '] ifFalse: ['put ']); tab; printNum: sz; tab; printNum: fmt; tab; printNum: fixed; tab; shortPrintOop: obj]]! Item was added: + ----- Method: StackInterpreter>>printCallStackOn: (in category 'debug printing redirected') ----- + printCallStackOn: aStdioStream + "Print the call stack on a specific output stream." + <export: true> "essential for writing crash.dmp; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" + <var: 'aStdioStream' type: #'FILE *'> + self withRedirectedOutputTo: aStdioStream do: [self printCallStack]! Item was changed: ----- Method: StackInterpreter>>printChar: (in category 'debug printing') ----- + printChar: aCharacter + "Write aCharacter to transcript. + This is a bit weird because, at least for me, fputc has its parameters backwards..." + <cmacro: '(aCharacter) fputc(aCharacter,transcript)'> + transcript fputc: aCharacter! - printChar: aByte - <api> - "For testing in Smalltalk, this method should be overridden in a subclass." - self putchar: aByte.! Item was changed: ----- Method: StackInterpreter>>printFloat: (in category 'debug printing') ----- printFloat: f + '%g' f: transcript printf: f! - "For testing in Smalltalk, this method should be overridden in a subclass." - <cmacro: '(f) printf("%g", f)'> - self print: f! Item was removed: - ----- Method: StackInterpreter>>printForwarder: (in category 'debug printing') ----- - printForwarder: oop - <inline: false> - self - print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop); - print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop). - objectMemory printHeaderTypeOf: oop. - self cr. - ^0! Item was changed: ----- Method: StackInterpreter>>printHex: (in category 'debug printing') ----- printHex: n "Print n in hex, in the form ' 0x1234', padded to a width of 10 characters + in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles). + In the simulator use 16r as the prefix, padding to 11 characters in 32-bits + or 19 characters in 64-bits." - in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles)" <api> <var: #n type: #usqInt> + <inline: false> + '%.*s16r%lx' f: transcript printf: { BytesPerWord * 8 - (n highBit max: 1) // 4. ' '. n }! - | len buf | - <var: #buf declareC: 'char buf[37]'> "large enough for a 64-bit value in hex plus the null plus 16 spaces" - self cCode: 'memset(buf,'' '',36)' inSmalltalk: [buf := 'doh!!']. - len := self cCode: 'sprintf(buf + 2 + 2 * BytesPerWord, "0x%" PRIxSQPTR, (usqIntptr_t)(n))'. - self cCode: 'printf("%s", buf + len)'. - len touch: buf! Item was changed: ----- Method: StackInterpreter>>printHexPtrnp: (in category 'debug printing') ----- printHexPtrnp: p + "Print p in hex, unpadded, in the form 0x1234 (C)/16r1234 (here)" - "Print p in hex, unpadded, in the form '0x1234'" <inline: true> <var: #p type: #'void *'> + ^'16r%lx' f: transcript printf: p asUnsignedInteger! - self printHexnp: (self oopForPointer: p)! Item was changed: ----- Method: StackInterpreter>>printHexnp: (in category 'debug printing') ----- printHexnp: n <api> <var: #n type: #usqInt> "Print n in hex, in the form '0x1234', unpadded" + ^'16r%lx' f: transcript printf: n! - ^'0x%lx' printf: n! Item was changed: ----- Method: StackInterpreter>>printHexnpnp: (in category 'debug printing') ----- printHexnpnp: n <var: #n type: #usqInt> + "Print n in hex, in the form '1234' (no prefix), unpadded" + ^'%lx' f: transcript printf: n! - "Print n in hex, in the form '1234', unpadded" - ^'%lx' printf: n! Item was changed: ----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') ----- printMethodCacheFor: thing <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" | 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: [] inSmalltalk: [self transcript ensureCr]. - [self cCode: [] inSmalltalk: [self transcript ensureCr]. self printNum: i; space; printHexnp: i; cr; tab. (objectMemory isBytesNonImm: s) + ifTrue: ['%p %.*s\n' f: transcript printf: { s. objectMemory numBytesOfBytes: s. objectMemory firstIndexableField: s }] - ifTrue: [self cCode: 'printf("%" PRIxSQPTR " %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))' - inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]] ifFalse: [self shortPrintOop: s]. self tab. (self addressCouldBeClassObj: c) ifTrue: [self shortPrintOop: 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>>printMethodDictionary: (in category 'debug printing') ----- printMethodDictionary: dictionary <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h" | methodArray | methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary. SelectorStart to: (objectMemory numSlotsOf: dictionary) - 1 do: [:index | | selector meth | selector := objectMemory fetchPointer: index ofObject: dictionary. selector ~= objectMemory nilObject ifTrue: [meth := objectMemory fetchPointer: index - SelectorStart ofObject: methodArray. self printOopShort: selector; print: ' => '; printOopShort: meth; print: ' ('; printHex: selector; print: ' => '; printHex: meth; + print: ')\n']]! - putchar: $); - cr]]! Item was changed: ----- Method: StackInterpreter>>printNum: (in category 'debug printing') ----- printNum: n + '%ld' f: transcript printf: n asInteger! - "For testing in Smalltalk, this method should be overridden in a subclass." - - self cCode: 'printf("%ld", (long) n)'.! Item was changed: ----- Method: StackInterpreter>>printOop: (in category 'debug printing') ----- printOop: oop <export: true> "use export: not api, so it won't be written to cointerp.h" + | cls fmt lastIndex startIP bytecodesPerLine column className length | - | cls fmt lastIndex startIP bytecodesPerLine column | <inline: false> (objectMemory isImmediate: oop) ifTrue: + [^objectMemory printImmediateObject: oop on: transcript]. - [^self shortPrintOop: oop]. - self printHex: oop. (objectMemory addressCouldBeObj: oop) ifFalse: + [^objectMemory printCantBeObject: oop on: transcript]. - [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [^self print: ' is misaligned'; cr]. - ((objectMemory isInNewSpace: oop) - and: [objectMemory isForwarded: oop]) ifTrue: - [self printForwarder: oop]. - ^self print: (self whereIs: oop); cr]. (objectMemory isFreeObject: oop) ifTrue: + [^objectMemory printFreeObject: oop on: transcript]. + (objectMemory isForwarded: oop) ifTrue: + [^objectMemory printForwarder: oop on: transcript]. + + (cls := objectMemory fetchClassOfNonImm: oop) ifNil: + [^'16r%lx has a nil class!!!!\n' f: transcript printf: oop]. + className := self nameOfClass: cls lengthInto: (self addressOf: length put: [:v| length := v]). + '16r%lx: a(n) %.*s' f: transcript printf: {oop. length. className }. - [self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop). - objectMemory hasSpurMemoryManagerAPI ifTrue: - [self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop). - objectMemory printHeaderTypeOf: oop]. - ^self cr]. - (objectMemory isForwarded: oop) ifTrue: - [^self printForwarder: oop]. - self print: ': a(n) '. - self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5. cls = (objectMemory splObj: ClassFloat) ifTrue: + [^'\n%g\n' f: transcript printf: (objectMemory dbgFloatValueOf: oop)]. - [^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr]. fmt := objectMemory formatOf: oop. fmt > objectMemory lastPointerFormat ifTrue: + [' nbytes %ld' f: transcript printf: (objectMemory numBytesOf: oop)]. - [self print: ' nbytes '; printNum: (objectMemory numBytesOf: 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'] - [self print: ' datasize '; printNum: (objectMemory sizeFieldOfAlien: oop). - self print: ((self isIndirectAlien: oop) - ifTrue: [' indirect @ '] ifFalse: [(self isPointerAlien: oop) + ifTrue: ['pointer'] + ifFalse: ['direct']]. + (self startOfAlienData: oop) asUnsignedInteger }]. + (self is: oop KindOfClass: (self superclassOf: (objectMemory splObj: ClassString))) ifTrue: + [^objectMemory printStringDataOf: oop on: transcript]. + ^objectMemory printNonPointerDataOf: oop on: transcript]. - ifTrue: [' pointer @ '] - ifFalse: [' direct @ ']]). - ^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr]. - (objectMemory isWordsNonImm: oop) ifTrue: - [lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize). - lastIndex > 0 ifTrue: - [1 to: lastIndex do: - [:index| - self space; printHex: (self cCoerceSimple: (objectMemory fetchLong32: index - 1 ofObject: oop) - to: #'unsigned int'). - (index \\ self elementsPerPrintOopLine) = 0 ifTrue: - [self cr]]. - (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse: - [self cr]]. - ^self]. - ^self printStringOf: oop; cr]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:index| self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space] 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 * objectMemory wordSize + 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: + ['0x%08p: ' f: transcript printf: (oop+BaseHeaderSize+index-1) asUnsignedIntegerPtr]. - [self cCode: 'printf("0x%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))' - inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", (int)byte,(int)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>>printOopShort: (in category 'debug printing') ----- printOopShort: oop + <inline: true> - <inline: false> self printOopShortInner: oop. self flush! Item was changed: ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') ----- printOopShortInner: oop | classOop name nameLen | <var: #name type: #'char *'> + <inline: false> - <inline: true> (objectMemory isImmediate: oop) ifTrue: [(objectMemory isImmediateCharacter: oop) ifTrue: + [^'$%c(%x)' f: transcript printf: { objectMemory characterValueOf: oop. objectMemory characterValueOf: oop }]. - [^self - printChar: $$; - printChar: (objectMemory characterValueOf: oop); - printChar: $(; - printHexnp: (objectMemory characterValueOf: oop); - printChar: $)]. (objectMemory isIntegerObject: oop) ifTrue: + [^'%ld(16r%lx)' f: transcript printf: { objectMemory integerValueOf: oop. objectMemory integerValueOf: oop }]. - [^self - printNum: (objectMemory integerValueOf: oop); - printChar: $(; - printHexnp: (objectMemory integerValueOf: oop); - printChar: $)]. (objectMemory isImmediateFloat: oop) ifTrue: + ['%g(16r%lx)' f: transcript printf: {objectMemory dbgFloatValueOf: oop. oop}]. + ^'unknown immediate 16r%lx' f: transcript printf: oop]. - [^self - printFloat: (objectMemory dbgFloatValueOf: oop); - printChar: $(; - printHexnp: oop; - printChar: $)]. - ^self print: 'unknown immediate '; printHexnp: oop]. (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 16r%lx' f: transcript printf: target]. - [^self print: ' is a forwarder to '; printHexnp: (objectMemory followForwarded: oop)]. (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 }. - self print: 'a(n) '. - self - cCode: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]] - inSmalltalk: - [name isString - ifTrue: [self print: name] - ifFalse: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]]. "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); - printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop); print: ' -> '; printHexnp: (objectMemory fetchPointer: ValueIndex ofObject: oop)]]! Item was changed: ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') ----- readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset "Read an image from the given file stream, allocating an amount of memory to its object heap. V3: desiredHeapSize is the total size of the heap. Fail if the image has an unknown format or requires more than the specified amount of memory. Spur: desiredHeapSize is ignored; this routine will attempt to provide at least extraVMMemory's ammount of free space after the image is loaded, taking any free space in teh image into account. extraVMMemory is stored in the image header and is accessible as vmParameterAt: 23. If extraVMMemory is 0, the value defaults to the default grow headroom. Fail if the image has an unknown format or if sufficient memory cannot be allocated. 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." | headerStart headerSize headerFlags dataSize oldBaseAddr swapBytes minimumMemory bytesRead bytesToShift heapSize firstSegSize hdrEdenBytes hdrMaxExtSemTabSize hdrNumStackPages allocationReserve | <var: #f type: #sqImageFile> <var: #heapSize type: #usqInt> <var: #dataSize type: #'size_t'> <var: #minimumMemory type: #usqInt> <var: #desiredHeapSize type: #usqInt> <var: #allocationReserve type: #usqInt> <var: #headerStart type: #squeakFileOffsetType> <var: #imageOffset type: #squeakFileOffsetType> + transcript := #stdout. "stdout is not available at compile time. this is the earliest available point." metaclassNumSlots := 6. "guess Metaclass instSize" classNameIndex := 6. "guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1" swapBytes := self checkImageVersionFrom: f startingAt: imageOffset. headerStart := (self sqImageFilePosition: f) - 4. "record header start position" headerSize := self getWord32FromFile: 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 getWord32FromFile: f swap: swapBytes. 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. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. It is used for the cog code size in Cog. Preserve it to be polite to other VMs." theUnknownShort := self getShortFromFile: f swap: swapBytes. hdrEdenBytes := self getWord32FromFile: 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]. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. Preserve it to be polite to other VMs." the2ndUnknownShort := self getShortFromFile: f swap: swapBytes. firstSegSize := self getLongFromFile: f swap: swapBytes. objectMemory firstSegmentSize: firstSegSize. "compare memory requirements with availability" allocationReserve := self interpreterAllocationReserveBytes. minimumMemory := dataSize + objectMemory newSpaceBytes + allocationReserve. objectMemory hasSpurMemoryManagerAPI ifTrue: [| freeOldSpaceInImage headroom | freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes. headroom := objectMemory initialHeadroom: extraVMMemory givenFreeOldSpaceInImage: freeOldSpaceInImage. heapSize := objectMemory roundUpHeapSize: dataSize + headroom + objectMemory newSpaceBytes + (headroom > allocationReserve ifTrue: [0] ifFalse: [allocationReserve])] ifFalse: [heapSize := desiredHeapSize + objectMemory newSpaceBytes + (desiredHeapSize - dataSize > allocationReserve ifTrue: [0] ifFalse: [allocationReserve]). heapSize < minimumMemory ifTrue: [self insufficientMemorySpecifiedError]]. "allocate a contiguous block of memory for the Squeak heap" (self allocateMemory: heapSize minimum: minimumMemory imageFile: f headerSize: headerSize) asUnsignedInteger ifNil: [self insufficientMemoryAvailableError] ifNotNil: [:mem| objectMemory setHeapBase: mem memoryLimit: mem + heapSize endOfMemory: mem + 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 := objectMemory readHeapFromImageFile: f dataBytes: dataSize. bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. self ensureImageFormatIsUpToDate: swapBytes. "compute difference between old and new memory base addresses" bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. self initializeInterpreter: bytesToShift. "adjusts all oops to new location" ^dataSize! Item was changed: ----- Method: StackInterpreter>>shortPrint: (in category 'simulation') ----- shortPrint: oop <doNotGenerate> | name classOop key | (objectMemory isImmediate: oop) ifTrue: [(objectMemory isImmediateCharacter: oop) ifTrue: [^(objectMemory characterValueOf: oop) < 256 ifTrue: ['=$', (objectMemory characterValueOf: oop) printString, ' ($', (String with: (Character value: (objectMemory characterValueOf: oop))), ')'] ifFalse: ['=$', (objectMemory characterValueOf: oop) printString, '($???)']]. (objectMemory isIntegerObject: oop) ifTrue: [^'=', (objectMemory integerValueOf: oop) printString, ' (', (objectMemory integerValueOf: oop) hex, ')']. (objectMemory isImmediateFloat: oop) ifTrue: [^ '=', (objectMemory floatValueOf: oop) printString, ' (', oop hex, ')']. ^'= UNKNOWN IMMEDIATE', ' (', (objectMemory integerValueOf: oop) hex, ')']. (objectMemory addressCouldBeObj: oop) ifFalse: [^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] ifFalse: [self whereIs: oop]]. (objectMemory isFreeObject: oop) ifTrue: [^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString, (objectMemory hasSpurMemoryManagerAPI ifTrue: [' 0th: ', (objectMemory fetchPointer: 0 ofFreeChunk: oop) hex] ifFalse: [''])]. (objectMemory isForwarded: oop) ifTrue: [^' is a forwarded object to ', (objectMemory followForwarded: oop) hex, ' of slot size ', (objectMemory numSlotsOfAny: oop) printString]. (objectMemory isFloatInstance: oop) ifTrue: [^'=', (objectMemory dbgFloatValueOf: oop) printString]. oop = objectMemory nilObject ifTrue: [^'nil']. oop = objectMemory falseObject ifTrue: [^'false']. oop = objectMemory trueObject ifTrue: [^'true']. classOop := objectMemory fetchClassOfNonImm: oop. ((self objCouldBeClassObj: oop) and: [(objectMemory numSlotsOf: classOop) = metaclassNumSlots]) ifTrue: [^'class ', (self nameOfClass: oop)]. name := self nameOfClass: classOop. name size = 0 ifTrue: [name := '??']. + (self is: oop KindOfClass: (self superclassOf: (objectMemory splObj: ClassString))) ifTrue: + [(name endsWith: #Symbol) ifTrue: + [^'#', (self stringOf: oop)]. + ^(self stringOf: oop) printString]. - (#('String' 'ByteString') includes: name) ifTrue: - [^(self stringOf: oop) printString]. - (#('Symbol' 'ByteSymbol') includes: name) ifTrue: - [^'#', (self stringOf: oop)]. name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters (see above); ObjectMemory does not" [^'=', (Character value: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop))) printString]. "Try to spot association-like things; they're all subclasses of LookupKey" ((objectMemory isPointersNonImm: oop) and: [classOop ~= objectMemory nilObject and: [((objectMemory instanceSizeOf: classOop) between: ValueIndex + 1 and: ValueIndex + 2) and: [(objectMemory addressCouldBeObj: (key := objectMemory fetchPointer: KeyIndex ofObject: oop)) and: [(key = objectMemory nilObject and: [self addressCouldBeClassObj: (objectMemory fetchPointer: ValueIndex ofObject: oop)]) or: [objectMemory isBytesNonImm: key]]]]]) ifTrue: [| classLookupKey | classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation). [classLookupKey = objectMemory nilObject ifTrue: [^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name]. (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse: [classLookupKey := self superclassOf: classLookupKey]. [(objectMemory instanceSizeOf: (self superclassOf: classLookupKey)) = (KeyIndex + 1)] whileTrue: [classLookupKey := self superclassOf: classLookupKey]. (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue: [^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name, ' ', (self shortPrint: (objectMemory fetchPointer: KeyIndex ofObject: oop)), ' -> ', (objectMemory fetchPointer: ValueIndex ofObject: oop) hex8]]. ^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name! Item was changed: ----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') ----- shortPrintOop: oop <inline: false> + | className length | - self printHexnp: oop. (objectMemory isImmediate: oop) ifTrue: + [^objectMemory printImmediateObject: oop on: transcript]. - [(objectMemory isIntegerObject: oop) ifTrue: - [self - cCode: ['=%ld\n' printf: {(objectMemory integerValueOf: oop) asLong}] - inSmalltalk: [self print: (self shortPrint: oop); cr]]. - (objectMemory isImmediateCharacter: oop) ifTrue: - [self - cCode: ['=$%ld ($%lc)\n' printf: {(objectMemory characterValueOf: oop) asLong. - self cCoerce: (objectMemory characterValueOf: oop) to: 'wint_t'}] - inSmalltalk: [self print: (self shortPrint: oop); cr]]. - (objectMemory isImmediateFloat: oop) ifTrue: - [self - cCode: ['=%g\n' printf: (objectMemory floatValueOf: oop)] - inSmalltalk: [self print: '='; printFloat: (objectMemory floatValueOf: oop); cr]]. - ^self]. (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]. + className := self + nameOfClass: (objectMemory fetchClassOfNonImm: oop) + lengthInto: (self addressOf: length put: [:v| length := v]). + '16r%lx: a(n) %.*s\n' f: transcript printf: {oop. length. className }! - [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 - ifTrue: [' is misaligned'] - ifFalse: [self whereIs: oop]); cr]. - ((objectMemory isFreeObject: oop) - or: [objectMemory isForwarded: oop]) ifTrue: - [^self printOop: oop]. - self print: ': a(n) '. - self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5. - self cr! Item was added: + ----- Method: StackInterpreter>>transcript (in category 'debug printing redirected') ----- + transcript + <doNotGenerate> + "N.B. can't use this as the C getter because C's namespace rules + don't allow a variable and a function to share the same name." + ^transcript! Item was added: + ----- Method: StackInterpreter>>transcript: (in category 'debug printing redirected') ----- + transcript: aStream + <doNotGenerate> + transcript := aStream! Item was added: + ----- Method: StackInterpreter>>warning: (in category 'cog jit support') ----- + warning: aString + <api: 'extern void warning(const char *s)'> + <doNotGenerate> + self transcript cr; nextPutAll: aString; flush! Item was added: + ----- Method: StackInterpreter>>withRedirectedOutputTo:do: (in category 'debug printing redirected') ----- + withRedirectedOutputTo: aStreamOrNil do: aBlock + <inline: #always> + | savedTranscript | + savedTranscript := transcript. + transcript := aStreamOrNil ifNil: [#stdout] ifNotNil: [aStreamOrNil]. + aBlock value. + transcript := savedTranscript! Item was changed: StackInterpreterPrimitives subclass: #StackInterpreterSimulator + instanceVariableNames: 'parent bootstrapping byteCount breakCount sendCount lookupCount printSends printReturns myBitBlt displayForm fakeForm filesOpen imageName pluginList mappedPluginEntries quitBlock displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES primTraceLog breakBlock inputSemaphoreIndex perMethodProfile' - instanceVariableNames: 'parent bootstrapping byteCount breakCount sendCount lookupCount printSends printReturns traceOn myBitBlt displayForm fakeForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES primTraceLog breakBlock inputSemaphoreIndex perMethodProfile' classVariableNames: 'ByteCountsPerMicrosecond' poolDictionaries: '' category: 'VMMaker-InterpreterSimulation'! !StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0! This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. To see the thing actually run, you could (after backing up this image and changes), execute (StackInterpreterSimulator new openOn: Smalltalk imageName) test ((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true)) openOn: 'ns101.image') test and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. Here's an example of what Eliot uses to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff: | vm | vm := StackInterpreterSimulator newWithOptions: #(). vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. vm setBreakSelector: #&. vm openAsMorph; run! Item was removed: - ----- Method: StackInterpreterSimulator>>cr (in category 'debug printing') ----- - cr - - traceOn ifTrue: [ transcript cr; flush ].! Item was changed: ----- Method: StackInterpreterSimulator>>ensureDebugAtEachStepBlock (in category 'testing') ----- ensureDebugAtEachStepBlock atEachStepBlock := [printFrameAtEachStep ifTrue: [self printFrame: localFP WithSP: localSP]. printBytecodeAtEachStep ifTrue: + [self printCurrentBytecodeOn: transcript]. - [self printCurrentBytecodeOn: transcript. - transcript cr; flush]. byteCount = breakCount ifTrue: ["printFrameAtEachStep :=" printBytecodeAtEachStep := true]. breakBlock ifNotNil: [breakBlock value ifTrue: [self halt]]]! Item was removed: - ----- Method: StackInterpreterSimulator>>flush (in category 'debug printing') ----- - flush - traceOn ifTrue: - [transcript flush. - "We *always* want to make output visible on flush" - TranscriptStream forceUpdate ifFalse: - [transcript changed: #appendEntry]]! Item was changed: ----- Method: StackInterpreterSimulator>>initialize (in category 'initialize-release') ----- initialize "Initialize the StackInterpreterSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." super initialize. bootstrapping := false. transcript := Transcript. objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. objectMemory coInterpreter: self. self assert: ConstMinusOne = (objectMemory integerObjectOf: -1). methodCache := Array new: MethodCacheSize. nsMethodCache := Array new: NSMethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. self initializePluginEntries. desiredNumStackPages := desiredEdenBytes := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds. "initialize InterpreterSimulator variables used for debugging" byteCount := sendCount := lookupCount := 0. quitBlock := [^self close]. - traceOn := true. printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form. suppressHeartbeatFlag := false. systemAttributes := Dictionary new. extSemTabSize := 256. disableBooleanCheat := false. assertVEPAES := false. "a flag so the assertValidExecutionPointers can be disabled for simulation speed and enabled when necessary."! Item was removed: - ----- Method: StackInterpreterSimulator>>print: (in category 'debug printing') ----- - print: it - - traceOn ifTrue: - [it isString ifTrue: [transcript nextPutAll: it] ifFalse: [it printOn: transcript]]! Item was removed: - ----- Method: StackInterpreterSimulator>>printChar: (in category 'debug printing') ----- - printChar: aByte - - traceOn ifTrue: [ transcript nextPut: aByte asCharacter ].! Item was changed: ----- Method: StackInterpreterSimulator>>printCurrentBytecodeOn: (in category 'debug printing') ----- printCurrentBytecodeOn: aStream | code | code := currentBytecode radix: 16. aStream ensureCr; print: localIP - method - 3; tab. bytecodeSetSelector > 0 ifTrue: [aStream nextPutAll: 'ALT ']. aStream nextPut: (code size < 2 ifTrue: [$0] ifFalse: [code at: 1]); nextPut: code last; space; nextPutAll: (BytecodeTable at: currentBytecode + 1); space; + nextPut: $(; print: byteCount + 1; nextPut: $); + cr; + flush! - nextPut: $(; print: byteCount + 1; nextPut: $)! Item was removed: - ----- Method: StackInterpreterSimulator>>printHex: (in category 'debug printing') ----- - printHex: anInteger - - traceOn ifTrue: - [transcript - next: 8 - (anInteger digitLength * 2) put: Character space; - nextPutAll: (anInteger storeStringBase: 16)]! Item was removed: - ----- Method: StackInterpreterSimulator>>printHexnp: (in category 'debug printing') ----- - printHexnp: anInteger - - traceOn ifTrue: - [transcript nextPutAll: ((anInteger ifNil: [0]) storeStringBase: 16)]! Item was removed: - ----- Method: StackInterpreterSimulator>>printHexnpnp: (in category 'debug printing') ----- - printHexnpnp: anInteger - "Print n in hex, in the form '1234', unpadded" - traceOn ifTrue: - [transcript nextPutAll: ((anInteger ifNil: [0]) printStringBase: 16)]! Item was removed: - ----- Method: StackInterpreterSimulator>>printNum: (in category 'debug printing') ----- - printNum: anInteger - - traceOn ifTrue: [ transcript print: anInteger ].! Item was removed: - ----- Method: StackInterpreterSimulator>>printStringForCurrentBytecode (in category 'debug printing') ----- - printStringForCurrentBytecode - ^String streamContents: [:str| self printCurrentBytecodeOn: str]! Item was removed: - ----- Method: StackInterpreterSimulator>>redirectTranscriptToHost (in category 'debug support') ----- - redirectTranscriptToHost - "Sometimes you need the capability to see the transcript output of the image into the - local transcript (for debugging when bootstrapping, for example). " - transcript := Transcript! Item was changed: ----- Method: StackInterpreterSimulator>>shortPrintContext: (in category 'debug printing') ----- shortPrintContext: aContext transcript ensureCr. ^super shortPrintContext: aContext! Item was removed: - ----- Method: StackInterpreterSimulator>>space (in category 'debug printing') ----- - space - - traceOn ifTrue: [ transcript space ]! Item was removed: - ----- Method: StackInterpreterSimulator>>sqShrinkMemory:By: (in category 'memory access') ----- - sqShrinkMemory: oldLimit By: delta - transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr. - - ^ oldLimit! Item was removed: - ----- Method: StackInterpreterSimulator>>tab (in category 'debug printing') ----- - tab - - traceOn ifTrue: [ transcript tab ].! Item was changed: ----- Method: StackInterpreterSimulator>>test (in category 'testing') ----- test self initStackPages. self loadInitialContext. transcript clear. byteCount := 0. breakCount := -1. quitBlock := [^self close]. printSends := printReturns := true. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. printFrameAtEachStep ifTrue: [self printFrame: localFP WithSP: localSP]. printBytecodeAtEachStep ifTrue: + [self printCurrentBytecodeOn: transcript]. - [self printCurrentBytecodeOn: Transcript. - Transcript cr; flush]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount. byteCount = breakCount ifTrue: ["printFrameAtEachStep :=" printBytecodeAtEachStep := true. self halt: 'hit breakCount break-point']]. self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>test1 (in category 'testing') ----- test1 self initStackPages. self loadInitialContext. transcript clear. byteCount := 0. breakCount := -1. self setBreakSelector: #blockCopy:. quitBlock := [^self close]. printSends := printReturns := true. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. "byteCount >= 22283 ifTrue: [(self checkIsStillMarriedContext: 22186072 currentFP: localFP) ifFalse: [self halt]]." (printBytecodeAtEachStep "and: [self isMarriedOrWidowedContext: 22189568]") ifTrue: ["| thePage | thePage := stackPages stackPageFor: (self frameOfMarriedContext: 22189568). thePage == stackPage ifTrue: [self shortPrintFrameAndCallers: localFP SP: localSP] ifFalse: [self shortPrintFrameAndCallers: thePage headFrameFP SP: thePage headFrameSP]." + self printCurrentBytecodeOn: transcript]. - self printCurrentBytecodeOn: Transcript. - Transcript cr; flush]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount. byteCount = breakCount ifTrue: ["printFrameAtEachStep := true." printSends := printBytecodeAtEachStep := true. self halt: 'hit breakCount break-point']]. self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>testBreakCount:printSends:printFrames:printBytecodes: (in category 'testing') ----- testBreakCount: breakCount printSends: shouldPrintSends printFrames: shouldPrintFrames printBytecodes: shouldPrintBytecodes self initStackPages. self loadInitialContext. transcript clear. byteCount := 0. quitBlock := [^self close]. printSends := true & shouldPrintSends. "true & foo allows evaluating printFoo := true in the debugger" printFrameAtEachStep := true & shouldPrintFrames. printBytecodeAtEachStep := true & shouldPrintBytecodes. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. printFrameAtEachStep ifTrue: [self printFrame: localFP WithSP: localSP]. printBytecodeAtEachStep ifTrue: + [self printCurrentBytecodeOn: transcript]. - [self printCurrentBytecodeOn: Transcript. - Transcript cr; flush]. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount. byteCount = breakCount ifTrue: ["printFrameAtEachStep :=" printBytecodeAtEachStep := true. self halt: 'hit breakCount break-point']]. self externalizeIPandSP! Item was removed: - ----- Method: StackInterpreterSimulator>>transcript (in category 'accessing') ----- - transcript - ^transcript! Item was removed: - ----- Method: StackInterpreterSimulator>>transcript: (in category 'accessing') ----- - transcript: aTranscript - transcript := aTranscript! Item was removed: - ----- Method: StackInterpreterSimulator>>warning: (in category 'debug support') ----- - warning: aString - transcript cr; nextPutAll: aString; flush! Item was changed: ----- Method: TConstantNode>>printOn:level: (in category 'printing') ----- printOn: aStream level: level value isSymbol ifTrue: [aStream nextPutAll: (value copyWithout: $:)] + ifFalse: [value isLiteral + ifTrue: [value printAsLiteralOn: aStream] + ifFalse: [value storeOn: aStream]]! - ifFalse: [value storeOn: aStream]! Item was changed: ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') ----- prepareMethodIn: aCodeGen "Record sends of builtin operators, map sends of the special selector dispatchOn:in: with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements. Declare limit variables for to:[by:]do: loops with limits that potentially have side-effects. As a hack also update the types of variables introduced to implement cascades correctly. This has to be done at the same time as this is done, so why not piggy back here?" extraVariableNumber ifNotNil: [declarations keysAndValuesDo: [:varName :decl| decl isBlock ifTrue: [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]). locals add: varName. self declarationAt: varName put: (decl value: self value: aCodeGen), ' ', varName]]]. aCodeGen pushScope: declarations while:"N.B. nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved." [parseTree nodesWithParentsDo: [:node :parent| node isSend ifTrue: [aCodeGen ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: node. (aCodeGen isBuiltinSelector: node selector) ifTrue: [node isBuiltinOperator: true. "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args" node selector = #to:by:do: ifTrue: [self ensureToByDoLoopLimitIsSafeAndEfficient: node in: aCodeGen]] ifFalse: [(StackInterpreter isStackAccessor: node selector) ifTrue: "compute and cache the accessor depth early, before inlining destroys the accessor chains" [self export ifTrue: [aCodeGen accessorDepthForMethod: self]] ifFalse: [(CaseStatements includes: node selector) ifTrue: [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node in: aCodeGen})]. (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })]. + (#(printf: fprintf: f:printf: f:wprintf:) includes: node selector) ifTrue: + [self transformPrintf: node]. + (node receiver isVariable + and: [node receiver name = #Character + and: [node selector isUnary]]) ifTrue: + [parent replaceNodesIn: (Dictionary newFromPairs: { node. TConstantNode new setValue: (Character perform: node selector) })]]]]]]! - (#(printf: f:printf:) includes: node selector) ifTrue: - [self transformPrintf: node]]]]]]! Item was changed: ----- Method: TMethod>>transformPrintf: (in category 'transformations') ----- transformPrintf: sendNode "Handle forms of f:printf: & printf:. f:printf: is either logFile f: formatLiteral printf: args or formatLiteral f: streamName printf: args printf is formatLiteral printf: args" | map newArgs | newArgs := OrderedCollection new. + sendNode changeClassTo: TVarArgsSendNode. sendNode args do: [:arg| arg isBrace ifTrue: [newArgs addAllLast: arg elements] ifFalse: [newArgs addLast: arg]]. (sendNode receiver isConstant and: [sendNode receiver value isString]) ifTrue: [| format | format := sendNode receiver asPrintfFormatStringNode. sendNode selector first == $f ifTrue: "fprintf et al..." [sendNode receiver: (TVariableNode new setName: 'self'). sendNode arguments: {sendNode args first. format}, newArgs allButFirst. ^sendNode]. sendNode receiver: format. sendNode arguments: newArgs. ^sendNode]. map := Dictionary new. sendNode nodesDo: [:subNode| (subNode isConstant and: [subNode value isString and: [subNode value includes: $%]]) ifTrue: [map at: subNode put: subNode asPrintfFormatStringNode]]. sendNode arguments: newArgs. sendNode replaceNodesIn: map. ^sendNode! Item was added: + ----- Method: TSendNode>>argumentSeparationBlockFor:numArgs:level: (in category 'C code generation') ----- + argumentSeparationBlockFor: aStream numArgs: numArgs level: level + ^[aStream nextPut: $,; space]! Item was changed: ----- Method: TSendNode>>emitCCodeAsFunctionCallOn:level:generator: (in category 'C code generation') ----- emitCCodeAsFunctionCallOn: aStream level: level generator: aCodeGen "Translate this message send into a C function call" selector == #break ifTrue: [aStream nextPutAll: '/* send of break elided */'. ^self]. "Special case for pluggable modules. Replace messages to interpreterProxy by interpreterProxy->message(..) if the message is not builtin" (aCodeGen shouldGenerateAsInterpreterProxySend: self) ifTrue: [(aCodeGen noteUsedPluginFunction: selector) ifTrue: [aStream nextPutAll: 'interpreterProxy->']]. aStream nextPutAll: (aCodeGen cFunctionNameFor: selector); nextPut: $(. "Only include the receiver as the first argument in certain cases. The receiver is always included if it is an expression. If it is a variable: If the vmClass says it is an implicit variable, don't include it. If the variable is 'self' and the method being called is not in the method set (i.e. it is some external code), don't include it." (self shouldExcludeReceiverAsFirstArgument: aCodeGen) ifFalse: [(receiver structTargetKindIn: aCodeGen) == #struct ifTrue: [aStream nextPut: $&]. receiver emitCCodeOn: aStream level: level generator: aCodeGen. arguments isEmpty ifFalse: [aStream nextPutAll: ', ']]. arguments do: [ :arg| arg emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen] + separatedBy: (self argumentSeparationBlockFor: aStream numArgs: arguments size level: level). - separatedBy: [aStream nextPut: $,; space]. aStream nextPut: $)! Item was added: + ----- Method: TSendNode>>isVarArgsSendNode (in category 'testing') ----- + isVarArgsSendNode + ^false! Item was changed: ----- Method: TSendNode>>printOn:level: (in category 'printing') ----- printOn: aStream level: level + self printParenthetically: receiver on: aStream level: level + 1. - | possiblyParenthesize | - possiblyParenthesize := - [:node :newLevel| - node - ifNil: [aStream print: node] - ifNotNil: - [(node isSend - and: [node selector precedence >= 3]) ifTrue: - [aStream nextPut: $(]. - node printOn: aStream level: newLevel. - (node isSend - and: [node selector precedence >= 3]) ifTrue: - [aStream nextPut: $)]]]. - - possiblyParenthesize value: receiver value: level. arguments size = 0 ifTrue: [aStream space; nextPutAll: selector. ^self]. selector keywords with: (arguments first: selector numArgs) do: [:keyword :arg | aStream space; nextPutAll: keyword; space. + self printParenthetically: arg on: aStream level: level + 1]! - possiblyParenthesize value: arg value: level + 1]! Item was added: + ----- Method: TSendNode>>printParenthetically:on:level: (in category 'printing') ----- + printParenthetically: node on: aStream level: level + node + ifNil: [aStream print: node] + ifNotNil: + [(node isSend + and: [node selector precedence >= 3]) + ifTrue: + [aStream nextPut: $(. + node printOn: aStream level: level. + aStream nextPut: $)] + ifFalse: [node printOn: aStream level: level]]! Item was added: + TSendNode subclass: #TVarArgsSendNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Translation to C'! Item was added: + ----- Method: TVarArgsSendNode>>argumentSeparationBlockFor:numArgs:level: (in category 'C code generation') ----- + argumentSeparationBlockFor: aStream numArgs: numArgs level: level + ^numArgs <= 2 + ifTrue: [super argumentSeparationBlockFor: aStream numArgs: numArgs level: level] + ifFalse: [[aStream nextPut: $,; crtab: level + 2]]! Item was added: + ----- Method: TVarArgsSendNode>>isVarArgsSendNode (in category 'testing') ----- + isVarArgsSendNode + ^true! Item was added: + ----- Method: TVarArgsSendNode>>printOn:level: (in category 'printing') ----- + printOn: aStream level: level + | keywords | + keywords := selector keywords. + keywords size = arguments size ifTrue: + [^super printOn: aStream level: level]. + keywords allButLast with: (arguments first: keywords size - 1) do: + [:keyword :arg | + aStream space; nextPutAll: keyword; space. + self printParenthetically: arg on: aStream level: level + 1]. + aStream space; nextPutAll: keywords last; space; nextPut: ${; space. + (arguments allButFirst: keywords size - 1) + do: [:arg| arg printOn: aStream level: level + 1] + separatedBy: [aStream nextPutAll: '. ']. + aStream nextPutAll: ' }'! Item was changed: + ----- Method: WriteStream>>fflush (in category '*VMMaker-debug printing interpreter support') ----- - ----- Method: WriteStream>>fflush (in category '*VMMaker-logging') ----- fflush "compatibility to map the stdio fflush(FILE *) routine onto flush" self flush! Item was added: + ----- Method: WriteStream>>fputc: (in category '*VMMaker-debug printing interpreter support') ----- + fputc: aCharacterOrCode + self nextPut: aCharacterOrCode asCharacter. + aCharacterOrCode asCharacter == Character cr ifTrue: + [self flush]!

1 0

why would a unix vm try to load libasound when the commando line is either squeak -help or squeak -vm-sound-null?
by tim Rowledge 28 Sep '21

28 Sep '21

OK, this is weird. I have an x64 cog.spur vm that runs on an x64 server. I am trying to move the system to another directory (strictly, a container running on the same machine). Normally it is run with `./bin/squeak -encoding UTF-8 -vm-sound-null -nodisplay Blah-64bit.image -doit "stuff to do" ` Today I started moving the files and in order to check things are getting the right permissions etc (always a pain on unix) I tired a simple `./bin/squeak -h` Which completely failed and replied ./bin/squeak: error while loading shared libraries: libasound.so.2: cannot open shared object file: No such file or directory So I checked on the working system and that *alsO* complains about libasound but replies ./bin/squeak -h unknown option: -h Usage: ./bin/squeak [<option>...] [<imageName> [<argument>...]] ./bin/squeak [<option>...] -- [<argument>...] options begin with single -, but -- prefix is silently accepted vm-sound-NAS tryLoading /srv/squeakbuildfactory/bin/vm-sound-NAS.so: dlopen: libaudio.so.2: cannot open shared object file: No such file or directory .... and then the expected help info. Which now makes two mysteries - a) why does the *same* vm executable behave differently ? b) why does it try to load libasound at all? Actually, three - on a Pi 64bit OS it doesn't complain about the libasound... tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim You can't make a program without broken egos.

3 6

[OpenSmalltalk/opensmalltalk-vm] 2c6788: Always use generic "pkg-config" except for 32-bit ...
by Marcel Taeumel 28 Sep '21

28 Sep '21

Branch: refs/heads/dtl/linux-runs-on-setting Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 2c67883bcba54442c3b4ccd49644df875532ccb1 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2c67883bcba54442c3… Author: Marcel Taeumel <marcel.taeumel(a)hpi.de> Date: 2021-09-28 (Tue, 28 Sep 2021) Changed paths: M platforms/unix/config/configure M platforms/unix/config/configure.ac Log Message: ----------- Always use generic "pkg-config" except for 32-bit x86 builds. Note that also our ARMv6 and ARMv8 setup works with "pkg-config". Just linux32x86 builds need "i686-linux-gnu-pkg-config" to find the right paths.

1 0

[OpenSmalltalk/opensmalltalk-vm] bac32e: Set PKG_CONFIG with a full /usr/bin/ path to not b...
by Marcel Taeumel 28 Sep '21

28 Sep '21

Branch: refs/heads/dtl/linux-runs-on-setting Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: bac32e38fde7df13992034670777235ac1ad2721 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/bac32e38fde7df1399… Author: Marcel Taeumel <marcel.taeumel(a)hpi.de> Date: 2021-09-28 (Tue, 28 Sep 2021) Changed paths: M platforms/unix/config/configure M platforms/unix/config/configure.ac Log Message: ----------- Set PKG_CONFIG with a full /usr/bin/ path to not be overwritten again.

1 0

[OpenSmalltalk/opensmalltalk-vm] 8b2c63: Fix syntax error. Sorry for the noise.
by Marcel Taeumel 28 Sep '21

28 Sep '21

Branch: refs/heads/dtl/linux-runs-on-setting Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 8b2c633483ba209ec6c1cc93e112242bc982121d https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/8b2c633483ba209ec6… Author: Marcel Taeumel <marcel.taeumel(a)hpi.de> Date: 2021-09-28 (Tue, 28 Sep 2021) Changed paths: M scripts/ci/actions_prepare_linux_x86.sh Log Message: ----------- Fix syntax error. Sorry for the noise.

1 0

← Newer
1
2
3
4
5
6
7
...
14
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev September 2021