Vm-dev November 2020

vm-dev@lists.squeakfoundation.org

18 participants
154 discussions

[OpenSmalltalk/opensmalltalk-vm] 529937: Avoid Big Sur refusal to compile when macosx-versi...
by Eliot Miranda 24 Nov '20

24 Nov '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 529937d09cdb1c296ed7bfb56f5de55a7c94941f https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/529937d09cdb1c296e… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-11-23 (Mon, 23 Nov 2020) Changed paths: M platforms/iOS/plugins/CameraPlugin/AVFoundationVideoGrabber.m Log Message: ----------- Avoid Big Sur refusal to compile when macosx-version-min<=10.7. [ci skip]

1 0

[OpenSmalltalk/opensmalltalk-vm] 79188a: CogVM source as per VMMaker.oscog-eem.2895
by Eliot Miranda 24 Nov '20

24 Nov '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 79188a3c8dbf80dcf71a99d752f5c925e653be2e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/79188a3c8dbf80dcf7… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-11-23 (Mon, 23 Nov 2020) Changed paths: M src/plugins/BochsIA32Plugin/BochsIA32Plugin.c M src/plugins/BochsX64Plugin/BochsX64Plugin.c M src/plugins/GdbARMPlugin/GdbARMPlugin.c M src/plugins/GdbARMv8Plugin/GdbARMv8Plugin.c M src/plugins/IA32ABI/IA32ABI.c M src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c M src/plugins/SqueakFFIPrims/ARM64FFIPlugin.c M src/plugins/SqueakFFIPrims/IA32FFIPlugin.c M src/plugins/SqueakFFIPrims/X64SysVFFIPlugin.c M src/plugins/SqueakFFIPrims/X64Win64FFIPlugin.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.2895 Avoid really ugly generated code for InterpreterPlugin>>sizeField:.

1 0

VM Maker: VMMaker.oscog-eem.2895.mcz
by commits＠source.squeak.org 24 Nov '20

24 Nov '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2895.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2895 Author: eem Time: 23 November 2020, 6:15:14.771492 pm UUID: b23435ec-e114-4c55-9349-24ab4b95baec Ancestors: VMMaker.oscog-eem.2894 Avoid really ugly generated code for InterpreterPlugin>>sizeField:. =============== Diff against VMMaker.oscog-eem.2894 =============== Item was changed: ----- Method: InterpreterPlugin>>sizeField: (in category 'alien support') ----- sizeField: alienOop "Answer the size field of an alienOop which is assumed to be an Alien of at least 8 bytes (32-bits) or 16 bytes (64 bits)" <inline: true> + ^self cCode: + [self longAt: alienOop + interpreterProxy baseHeaderSize] + inSmalltalk: + [| field | + field := interpreterProxy longAt: alienOop + interpreterProxy baseHeaderSize. + interpreterProxy wordSize = 8 + ifTrue: [field signedIntFromLong64] + ifFalse: [field signedIntFromLong]]! - ^interpreterProxy wordSize = 8 - ifTrue: [(interpreterProxy longAt: alienOop + interpreterProxy baseHeaderSize) signedIntFromLong64] - ifFalse: [(interpreterProxy longAt: alienOop + interpreterProxy baseHeaderSize) signedIntFromLong]!

1 0

Build failed: opensmalltalk-vm 1.0.2316
by AppVeyor 23 Nov '20

23 Nov '20

1 0

Errored: OpenSmalltalk/opensmalltalk-vm#2312 (Cog - d424c8e)
by Travis CI 23 Nov '20

23 Nov '20

Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #2312 Status: Errored Duration: 1 hr, 35 mins, and 28 secs Commit: d424c8e (Cog) Author: Eliot Miranda Message: Allow Mac builds to use whatever the installed SDK is. Bump the minimum supported target up to 10.9 (Mavericks). View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/bd18c0e86619...d4… View the full build log and details: https://travis-ci.org/github/OpenSmalltalk/opensmalltalk-vm/builds/74547945… -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&ut…. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notificati…. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications.

1 0

[OpenSmalltalk/opensmalltalk-vm] a49b21: Add commentary to the Mac Makefiles on how to unlo...
by Eliot Miranda 23 Nov '20

23 Nov '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: a49b2135dc336c2efe3ae5a81b61aa689d9ff122 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/a49b2135dc336c2efe… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-11-23 (Mon, 23 Nov 2020) Changed paths: M build.macos32x86/common/Makefile.app M build.macos64ARMv8/common/Makefile.app M build.macos64x64/common/Makefile.app Log Message: ----------- Add commentary to the Mac Makefiles on how to unlock one's keychain when using ssh. [ci skip]

1 0

[OpenSmalltalk/opensmalltalk-vm] d424c8: Allow Mac builds to use whatever the installed SDK...
by Eliot Miranda 23 Nov '20

23 Nov '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: d424c8e49346914b5dfa80341108d990b2df636b https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/d424c8e49346914b5d… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-11-23 (Mon, 23 Nov 2020) Changed paths: M build.macos32x86/common/Makefile.flags M build.macos64ARMv8/common/Makefile.flags M build.macos64x64/common/Makefile.flags Log Message: ----------- Allow Mac builds to use whatever the installed SDK is. Bump the minimum supported target up to 10.9 (Mavericks).

1 0

VM Maker: VMMaker.oscog-eem.2894.mcz
by commits＠source.squeak.org 23 Nov '20

23 Nov '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2894.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2894 Author: eem Time: 22 November 2020, 9:46:07.518953 pm UUID: 6c77c06e-a17e-4dcf-85d9-90943dd5eae8 Ancestors: VMMaker.oscog-eem.2893 MTVM: Separate from MultiProcessor. Have CogThreadManager>>releaseVM & tryLockVMOwnerTo: simulate thread switches, since these are effectively the only places they occur in this simple threading scheme. The full complexity of MultiProcessor isn't needed. To make this work change all senders of tryLockVMOwnerTo: to invoke CogThreadManager's simulation-only wrapper around Cogit>>tryLockVMOwnerTo:. Simplify and correct checks and initialization of the processor's thread-specific stack pointers. Provide a multi-threaded version of primtRumpCStack that prints the individual stacks for active threads. =============== Diff against VMMaker.oscog-eem.2893 =============== Item was changed: ----- Method: CoInterpreter>>assertValidExternalStackPointers (in category 'debug support') ----- assertValidExternalStackPointers + <doNotGenerate> "For use *ONLY* by routines coming in to the VM, + i.e. handleCallOrJumpSimulationTrap:. This is because it nils localFP as a side-effect, + and it does so so that the head frame can be determined reliably." - i.e. handleCallOrJumpSimulationTrap:. This is because it nils localFP as a side-effect." self assert: framePointer < stackPage baseAddress. self assert: stackPointer < framePointer. self assert: framePointer > stackPointer. self assert: stackPointer >= (stackPage realStackLimit - self stackLimitOffset). localFP := nil! Item was removed: - ----- Method: CoInterpreter>>setFramePointer:stackPointer:for: (in category 'initialization') ----- - setFramePointer: cFramePointer stackPointer: cStackPointer for: processor - <doNotGenerate> - processor - setFramePointer: (self setCFramePointer: cFramePointer) - stackPointer: (self setCStackPointer: cStackPointer)! Item was changed: ----- Method: CoInterpreterMT>>assertCStackPointersBelongToCurrentThread (in category 'simulation') ----- assertCStackPointersBelongToCurrentThread + <cmacro: '(ignored) 0'> "simulation only" - <cmacro: '() 0'> "simulation only" | ownerIndex range | self assert: (ownerIndex := cogThreadManager getVMOwner) > 0. + range := self cStackRangeForThreadIndex: ownerIndex. + self assert: ((range includes: CFramePointer) and: [range includes: CStackPointer])! - self assert: ((range := self cStackRangeForThreadIndex: ownerIndex) includes: CFramePointer). - self assert: (range includes: CStackPointer)! Item was added: + ----- Method: CoInterpreterMT>>assertProcessorStackPointersBelongToCurrentThread (in category 'simulation') ----- + assertProcessorStackPointersBelongToCurrentThread + <cmacro: '(ignored) 0'> "simulation only" + | ownerIndex range | + self assert: (ownerIndex := cogThreadManager getVMOwner) > 0. + range := self cStackRangeForThreadIndex: ownerIndex. + self assert: ((range includes: cogit processor fp) and: [range includes: cogit processor sp])! Item was changed: ----- Method: CoInterpreterMT>>enterSmalltalkExecutiveImplementation (in category 'initialization') ----- enterSmalltalkExecutiveImplementation "Main entry-point into the interpreter at each execution level, where an execution level is either the start of execution or reentry for a callback. Capture the C stack pointers so that calls from machine-code into the C run-time occur at this level. This is the actual implementation, separated from enterSmalltalkExecutive so the simulator can wrap it in an exception handler and hence simulate the setjmp/longjmp. Override to return if a longjmp to reenterInterpreter passes a parameter greater than 1. This causes a return to threadSchedulingLoop:startingVM: and is used to surrender control to another thread." <inline: false> self assertSaneThreadAndProcess. + self assertProcessorStackPointersBelongToCurrentThread. "At this point CFramePointer/CStackPointer have yet to be assigned". ^super enterSmalltalkExecutiveImplementation! Item was changed: ----- Method: CoInterpreterMT>>returnToSchedulingLoopAndReleaseVMOrWakeThread:source: (in category 'process primitive support') ----- returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: source <var: #vmThread type: #'CogVMThread *'> <inline: false> - self cCode: - [self flag: 'this is just for debugging. Note the current C stack pointers'. - cogThreadManager currentVMThread - cStackPointer: CStackPointer; - cFramePointer: CFramePointer] - inSmalltalk: - [| range | range := self cStackRangeForThreadIndex: cogThreadManager getVMOwner. - self assert: ((range includes: CStackPointer) and: [range includes: CFramePointer])]. self recordThreadSwitchTo: (vmThread ifNotNil: [vmThread index] ifNil: [0]) source: source. vmThread ifNotNil: [cogThreadManager wakeVMThreadFor: vmThread index] ifNil: [cogThreadManager releaseVM]. "I am not frightened of flying. Any value will do. I don't mind. Why should I be frightened of flying? There's no reason for it." self _longjmp: reenterThreadSchedulingLoop _: 1 ! Item was removed: - ----- Method: CoInterpreterMT>>setFramePointer:stackPointer:for: (in category 'initialization') ----- - setFramePointer: cFramePointer stackPointer: cStackPointer for: processor - <doNotGenerate> - self flag: #design. - CFramePointer ifNil: - [self setCFramePointer: cFramePointer; setCStackPointer: cStackPointer]. - processor - setFramePointer: cFramePointer - stackPointer: cStackPointer! Item was changed: ----- Method: CoInterpreterMT>>threadSchedulingLoop: (in category 'vm scheduling') ----- threadSchedulingLoop: vmThread "Enter a loop attempting to run the VM with the highest priority process and blocking on the thread's OS semaphore when unable to run that process. This version is for simulation only, simulating the longjmp back to the real threadSchedulingLoopImplementation: through exception handling." <cmacro: '(vmThread) threadSchedulingLoopImplementation(vmThread)'> + cogit initializeProcessorStack: (self cStackRangeForThreadIndex: vmThread index) last. - self initializeProcessorForThreadIndex: vmThread index. [[self threadSchedulingLoopImplementation: vmThread] on: ReenterThreadSchedulingLoop do: [:ex| self assert: ex returnValue = 1. ex return: true]] whileTrue! Item was added: + ----- Method: CogThreadManager>>ensureInitializedProcessor:forThreadIndex: (in category 'simulation') ----- + ensureInitializedProcessor: aProcessor forThreadIndex: threadIndex + "Ensure aProcessor has stack pointers within its defined range, initializing it if not." + <doNotGenerate> + | range | + range := coInterpreter cStackRangeForThreadIndex: threadIndex. + self assert: (range includes: aProcessor fp) = (range includes: aProcessor sp). + ((range includes: aProcessor fp) and: [range includes: aProcessor sp]) ifFalse: + [aProcessor smashCallerSavedRegistersWithValuesFrom: 16r90000000 by: coInterpreter objectMemory wordSize / 2. + cogit initializeProcessorStack: range last]! Item was changed: ----- Method: CogThreadManager>>releaseVM (in category 'public api') ----- releaseVM + "In the simulation this is where register state is saved; it is switched in tryLockVMOwnerTo:." + self cCode: [] inSmalltalk: + [vmOwner ~= 0 ifTrue: + [registerStates at: vmOwner put: cogit processor registerState]]. self setVMOwner: 0! Item was added: + ----- Method: CogThreadManager>>threadsDo: (in category 'simulation') ----- + threadsDo: aBlock + 1 to: numThreads do: + [:i| + (threads at: i) ifNotNil: + [:thread| aBlock value: thread]]! Item was changed: ----- Method: CogThreadManager>>tryLockVMOwnerTo: (in category 'simulation') ----- + tryLockVMOwnerTo: threadIndex - tryLockVMOwnerTo: value "In the real VM this is a direct call of Cogit>>#tryLockVMOwnerTo:/ceTryLockVMOwner. + In the simulation this is where register state is saved and switched, simulaitng a thread switch. + releaseVM also saves register state. The code here and in registerState allow us to avoid the + expensive and complex MultiProcessor hack." - In the simulation this is where we save and switch register state." <doNotGenerate> + | prior processor result | + self deny: threadIndex = 0. - | current post prior processor | processor := cogit processor. prior := processor registerState. + "A thread switch would (have) occur(ed) if it were that the VM were owned other than by threadIndex" + vmOwner ~= threadIndex ifTrue: + [vmOwner ~= 0 ifTrue: + [registerStates at: vmOwner put: prior]. + processor setRegisterState: (registerStates + at: threadIndex + ifAbsentPut: + [self ensureInitializedProcessor: processor forThreadIndex: threadIndex. + processor registerState])]. + result := cogit tryLockVMOwnerTo: threadIndex. + self assert: result = (threadIndex = vmOwner). + registerStates at: threadIndex put: processor registerState. + threadIndex ~= vmOwner ifTrue: "the lock attempt failed; undo the (processor) thread switch." + [processor setRegisterState: prior]. + ^result! - vmOwner ~= 0 ifTrue: - [registerStates at: vmOwner put: prior]. - (cogit tryLockVMOwnerTo: value) ifFalse: - [^false]. - post := processor registerState. - current := registerStates - at: vmOwner - ifAbsentPut: - [self assert: vmOwner = value. - processor voidRegisterState; registerState]. - 1 to: prior size do: - [:i| | neuf | - (prior at: i) ~= (neuf := post at: i) ifTrue: - [current at: i put: neuf]]. - cogit processor setRegisterState: current. - ^true! Item was changed: ----- Method: CogVMSimulator>>ownVM: (in category 'debugging traps') ----- ownVM: threadIndexAndFlags "This method includes or excludes CoInterpreterMT methods as required. Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" + "(threadIndexAndFlags anyMask: DisownVMForProcessorRelinquish << DisownFlagsShift) ifFalse: + [self break]." - (threadIndexAndFlags anyMask: DisownVMForProcessorRelinquish << DisownFlagsShift) ifFalse: - [self break]. ^self perform: #ownVM: withArguments: {threadIndexAndFlags} inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was changed: ----- Method: CogVMSimulator>>printRumpCStack (in category 'rump c stack') ----- printRumpCStack + cogThreadManager ifNil: + [^self printRumpCStackTo: heapBase - objectMemory wordSize]. + cogThreadManager threadsDo: + [:thread| self printRumpCStackForThread: thread]! - self printRumpCStackTo: heapBase - objectMemory wordSize! Item was added: + ----- 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; cr. + self printRumpCStackFrom: start to: coldTop cfp: thread cFramePointer csp: thread cStackPointer. + range first < start ifTrue: + [self print: 'zeros...'; cr]! Item was added: + ----- Method: CogVMSimulator>>printRumpCStackFrom:to:cfp:csp: (in category 'rump c stack') ----- + printRumpCStackFrom: start to: address cfp: cfp csp: csp + address + to: start + by: objectMemory wordSize negated + do: [:addr| | label | + self printHex: addr. + addr = cogit processor sp ifTrue: [label := ' sp']. + addr = cogit processor fp ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'fp']. + addr = csp ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'CSP']. + addr = cfp ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'CFP']. + label ifNil: [self tab] ifNotNil: [self print: ' ', label, '->']. + self tab; printHex: (objectMemory longAt: addr); cr]! Item was changed: ----- Method: CogVMSimulator>>printRumpCStackTo: (in category 'rump c stack') ----- printRumpCStackTo: address | start | self assert: (self isOnRumpCStack: address). start := heapBase - self rumpCStackSize. [start < address and: [(objectMemory longAt: start) = 0]] whileTrue: [start := start + objectMemory wordSize]. start := start - (3 * objectMemory wordSize) max: heapBase - self rumpCStackSize. + self printRumpCStackFrom: start to: address cfp: CFramePointer csp: CStackPointer. - address - to: start - by: objectMemory wordSize negated - do: [:addr| | label | - self printHex: addr. - addr = cogit processor sp ifTrue: [label := ' sp']. - addr = cogit processor fp ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'fp']. - addr = CStackPointer ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'CSP']. - addr = CFramePointer ifTrue: [label := (label ifNil: [''] ifNotNil: [label, ',']), 'CFP']. - label ifNil: [self tab] ifNotNil: [self print: ' ', label, '->']. - self tab; printHex: (objectMemory longAt: addr); cr]. heapBase - self rumpCStackSize < start ifTrue: [self print: 'zeros...'; cr]! Item was removed: - ----- Method: CogVMSimulator>>setFramePointer:stackPointer:for: (in category 'multi-threading simulation switch') ----- - setFramePointer: cFramePointer stackPointer: cStackPointer for: processor - "This method includes or excludes CoInterpreterMT methods as required. - Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" - - ^self perform: #setFramePointer:stackPointer:for: - withArguments: {cFramePointer. cStackPointer. processor} - inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was changed: ----- Method: Cogit>>ceCaptureCStackPointers (in category 'jit - api') ----- ceCaptureCStackPointers <api: 'extern void (*ceCaptureCStackPointers)()'> <doNotGenerate> - | range | coInterpreter isCurrentImageFacade ifTrue: [^self]. self simulateLeafCallOf: ceCaptureCStackPointers. thisContext sender selector == #generateStackPointerCapture ifTrue: [^self]. coInterpreter isThreadedVM ifTrue: + [coInterpreter assertProcessorStackPointersBelongToCurrentThread]! - [range := coInterpreter cStackRangeForThreadIndex: coInterpreter threadManager getVMOwner. - self assert: (range notNil "VM is owned" - and: [(range includes: coInterpreter getCFramePointer) - and: [range includes: coInterpreter getCStackPointer]])]! Item was changed: ----- Method: Cogit>>initializeProcessorStack: (in category 'initialization') ----- initializeProcessorStack: rumpCStackAddress "Initialize the simulation processor's stack pointers, arranging that they are somewhere on the rump C stack." <doNotGenerate> | stackPad cFramePointer cStackPointer | stackPad := 64 max: cStackAlignment. cStackPointer := rumpCStackAddress - stackPad + expectedSPAlignment. cFramePointer := rumpCStackAddress - stackPad + cStackAlignment + expectedFPAlignment. self assert: cStackPointer \\ cStackAlignment = expectedSPAlignment. self assert: cFramePointer \\ cStackAlignment = expectedFPAlignment. + processor setFramePointer: cFramePointer stackPointer: cStackPointer! - coInterpreter setFramePointer: cFramePointer stackPointer: cStackPointer for: processor! Item was removed: - ----- Method: CurrentImageCoInterpreterFacade>>setFramePointer:stackPointer:for: (in category 'accessing') ----- - setFramePointer: cFramePointer stackPointer: cStackPointer for: processor - ^coInterpreter setFramePointer: cFramePointer stackPointer: cStackPointer for: processor!

1 0

VM Maker: Cog-eem.428.mcz
by commits＠source.squeak.org 23 Nov '20

23 Nov '20

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.428.mcz ==================== Summary ==================== Name: Cog-eem.428 Author: eem Time: 22 November 2020, 9:40:06.97214 pm UUID: ce3f36e8-89b5-4ce8-8636-8a967ae4d08a Ancestors: Cog-eem.427 Separating from MultiProcessor. =============== Diff against Cog-eem.427 =============== Item was changed: Object subclass: #MultiProcessor instanceVariableNames: 'mutex processor guardedProcessorProtocol unguardedProcessorProtocol owner registerState coInterpreter threadIndex cogit' classVariableNames: '' poolDictionaries: '' category: 'Cog-Processors'! + + !MultiProcessor commentStamp: 'eem 11/22/2020 21:28' prior: 0! + A MultiProcessor is a hack for implementing a multi-processor above a single processor simulation. It is an expensive anachronism, now being replaced by simpler code in CogThreadManager>>releaseVM and CogThreadManager>>tryLockVMOwnerTo:. Never the less it has some interesting and potentially useful exception handling code in its doesNotUnderatand: method so we keep it for reference. + + Instance Variables + coInterpreter: <Object> + cogit: <Object> + guardedProcessorProtocol: <Object> + mutex: <Object> + owner: <Object> + processor: <Object> + registerState: <Object> + threadIndex: <Object> + unguardedProcessorProtocol: <Object> + + coInterpreter + - xxxxx + + cogit + - xxxxx + + guardedProcessorProtocol + - xxxxx + + mutex + - xxxxx + + owner + - xxxxx + + processor + - xxxxx + + registerState + - xxxxx + + threadIndex + - xxxxx + + unguardedProcessorProtocol + - xxxxx + !

1 0

VM Maker: VMMaker-dtl.419.mcz
by commits＠source.squeak.org 23 Nov '20

23 Nov '20

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.419.mcz ==================== Summary ==================== Name: VMMaker-dtl.419 Author: dtl Time: 22 November 2020, 11:52:26.748 am UUID: 13a52440-38ce-414c-92a9-8a2ba438b91b Ancestors: VMMaker-dtl.418 Extend image version compatibility. For Squeak 6 alpha (current trunk): Remove use of deprecated hideVScrollBarIndefinitely: with possible cosmetic impact on older image versions but otherwise harmless to remove. Provide a compatibility method to handle the renaming of includesSubString: to includesSubstring: Handle the removal of CrLfFileStream. For circa Squeak 3.8: Use ifNotNilDo: instead of ifNotNil: when passing a block argument. Use ifNil:ifNotNilDo: instead of ifNil:ifNotNil: when passing a block argument. Note, early images require Pragmatizer to undo pragma usage =============== Diff against VMMaker-dtl.418 =============== Item was changed: ----- Method: BalloonEngineBase class>>initialize (in category 'class initialization') ----- initialize "BalloonEngineBase initialize" "BalloonEnginePlugin translateDoInlining: true." EdgeInitTable := self initializeEdgeInitTable. EdgeStepTable := self initializeEdgeStepTable. WideLineWidthTable := self initializeWideLineWidthTable. WideLineFillTable := self initializeWideLineFillTable. FillTable := self initializeFillTable. + (Smalltalk classNamed: #BalloonEngineConstants) ifNotNilDo: - (Smalltalk classNamed: #BalloonEngineConstants) ifNotNil: [:balloonEngineConstants| (balloonEngineConstants classPool anySatisfy: [:classVarValue| classVarValue isNil]) ifTrue: [balloonEngineConstants initialize]]! Item was changed: ----- Method: BalloonEngineSimulation>>copyBitsFrom:to:at: (in category 'simulation') ----- copyBitsFrom: x0 to: x1 at: y "Simulate the copyBits primitive" | bb | bbObj isInteger ifTrue: ["Create a proxy object to handle BitBlt calls" bb := savedBBObj ifNil: [BitBltSimulator new initialiseModule; setInterpreter: interpreterProxy; yourself] + ifNotNilDo: [savedBBObj]. - ifNotNil: [savedBBObj]. (bb loadBitBltFrom: bbObj) ifTrue: [bbObj := bb] ifFalse: [^ self]]. bbObj copyBitsFrom: x0 to: x1 at: y. " interpreterProxy showDisplayBits: bbObj destForm Left: bb affectedLeft Top: bb affectedTop Right: bb affectedRight Bottom: bb affectedBottom. "! Item was changed: ----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') ----- addMethodFor: aClass selector: selector "Add the given method to the code base and answer its translation or nil if it shouldn't be translated." | method tmethod | method := aClass compiledMethodAt: selector. method requiresConcreteImplementation ifTrue: [abstractDeclarations add: selector]. method isAbstract ifTrue: [^nil]. (method pragmaAt: #doNotGenerate) ifNotNil: [^nil]. "process optional methods by interpreting the argument to the option: pragma as either a Cogit class name or a class variable name or a variable name in VMBasicConstants." + (method pragmaAt: #option:) ifNotNilDo: - (method pragmaAt: #option:) ifNotNil: [:pragma| | key | key := pragma argumentAt: 1. "((Cogit withAllSubclasses anySatisfy: [:c| c name = key]) and: [VMClass getVMMaker cogitClassName ~= key]) ifTrue: [^nil]." + (aClass bindingOf: key) ifNotNilDo: - (aClass bindingOf: key) ifNotNil: [:binding| binding value ifFalse: [^nil]]. + (VMBasicConstants bindingOf: key) ifNotNilDo: - (VMBasicConstants bindingOf: key) ifNotNil: [:binding| binding value ifFalse: [^nil]]]. tmethod := self compileToTMethodSelector: selector in: aClass. tmethod hasDoNotGenerateStatement ifTrue: [^nil]. self addMethod: tmethod. "If the method has a macro then add the macro. But keep the method for analysis purposes (e.g. its variable accesses)." + (method pragmaAt: #cmacro:) ifNotNilDo: - (method pragmaAt: #cmacro:) ifNotNil: [:pragma| self addMacro: (pragma argumentAt: 1) for: selector]. + (method propertyValueAt: #cmacro:) ifNotNilDo: - (method propertyValueAt: #cmacro:) ifNotNil: [:macro| self addMacro: macro for: selector]. ^tmethod! Item was changed: ----- Method: CCodeGenerator>>addStructMethodFor:selector: (in category 'utilities') ----- addStructMethodFor: aClass selector: selector "Add the given struct method to the code base and answer its translation or nil if it shouldn't be translated." + ^(self addMethodFor: aClass selector: selector) ifNotNilDo: - ^(self addMethodFor: aClass selector: selector) ifNotNil: [:tmethod| tmethod transformToStructClassMethodFor: self. tmethod]! Item was changed: ----- Method: CCodeGenerator>>declToType: (in category 'public') ----- declToType: decl "Extracts the type from a C declaration string" | strs r | decl isNil ifFalse: [ (decl indexOf: $=) > 0 ifTrue: [ strs := (decl copyFrom: 1 to: ((decl indexOf: $=) - 1)) ] ifFalse: [ strs := decl ]. strs := (strs withoutTrailingBlanks) subStrings: ' '. strs size == 1 ifTrue: [ ^ strs first ] ifFalse: [ | asterisks | r := ''. strs allButLastDo: [ :s | r := r,s,' ' ]. "Bit of a hack to get 'type *'" asterisks := (strs last copyFrom: 1 to: (strs last lastIndexOf: $*)). asterisks size > 0 ifTrue: [ r := r,' ',asterisks ]. r := r withoutTrailingBlanks. + (((r indexOf: $( ) > 0) or: [ (r indexOf: $) ) > 0 ] ) ifTrue: [ ^nil ]. - (((r indexOf: $() > 0) or: ((r indexOf: $)) > 0)) ifTrue: [ ^nil ]. ^r withoutTrailingBlanks ]. ] ifTrue: [ ^nil ].! Item was changed: ----- Method: CCodeGenerator>>extractTypeFor:fromDeclaration: (in category 'utilities') ----- extractTypeFor: aVariable fromDeclaration: aVariableDeclaration "Eliminate inessentials from aVariableDeclaration to answer a C type without the variable, or initializations etc" | decl | decl := aVariableDeclaration. (decl beginsWith: 'static') ifTrue: [decl := decl allButFirst: 6]. + (decl indexOf: $= ifAbsent: []) ifNotNilDo: - (decl indexOf: $= ifAbsent: []) ifNotNil: [:index| decl := decl copyFrom: 1 to: index - 1]. decl := decl copyReplaceAll: aVariable with: '' tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]]. ^self baseTypeForType: decl! Item was changed: ----- Method: CCodeGenerator>>generateIfFalse:on:indent: (in category 'C translation') ----- generateIfFalse: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." (self nilOrBooleanConstantReceiverOf: msgNode) ifNil: [aStream nextPutAll: 'if (!!('. msgNode receiver emitCCodeAsExpressionOn: aStream level: level + 1 generator: self. aStream nextPutAll: ')) {'; cr. msgNode args last emitCCodeOn: aStream level: level + 1 generator: self. level timesRepeat: [aStream tab]. aStream nextPut: $}] + ifNotNilDo: - ifNotNil: [:const | const ifFalse: [msgNode args first emitCCodeOn: aStream level: level generator: self]]! Item was changed: ----- Method: CCodeGenerator>>generateIfFalseAsArgument:on:indent: (in category 'C translation') ----- generateIfFalseAsArgument: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." (self nilOrBooleanConstantReceiverOf: msgNode) ifNil: [aStream nextPutAll: '(!!('. msgNode receiver emitCCodeAsArgumentOn: aStream level: 0 generator: self. aStream nextPut: $); crtab: level + 1; nextPut: $?; space. msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self. aStream crtab: level + 1; nextPutAll: ': 0)'] + ifNotNilDo: - ifNotNil: [:const| const ifFalse: [msgNode args first emitCCodeAsArgumentOn: aStream level: level generator: self]]! Item was changed: ----- Method: CCodeGenerator>>generateIfFalseIfTrue:on:indent: (in category 'C translation') ----- generateIfFalseIfTrue: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." (self nilOrBooleanConstantReceiverOf: msgNode) ifNil: [aStream nextPutAll: 'if ('. msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self. aStream nextPutAll: ') {'; cr. msgNode args last emitCCodeOn: aStream level: level + 1 generator: self. aStream tab: level; nextPut: $}; nextPutAll: ' else {'; cr. msgNode args first emitCCodeOn: aStream level: level + 1 generator: self. aStream tab: level; nextPut: $}] + ifNotNilDo: - ifNotNil: [:const | (const ifTrue: [msgNode args last] ifFalse: [msgNode args first]) emitCCodeOn: aStream level: level generator: self]! Item was changed: ----- Method: CCodeGenerator>>generateIfFalseIfTrueAsArgument:on:indent: (in category 'C translation') ----- generateIfFalseIfTrueAsArgument: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." (self nilOrBooleanConstantReceiverOf: msgNode) ifNil: [aStream nextPut: $(. msgNode receiver emitCCodeAsArgumentOn: aStream level: level generator: self. aStream crtab: level + 1; nextPut: $?; space. msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self. aStream crtab: level + 1; nextPut: $:; space. msgNode args first emitCCodeAsArgumentOn: aStream level: level + 2 generator: self. aStream nextPut: $)] + ifNotNilDo: - ifNotNil: [:const| (const ifTrue: [msgNode args last] ifFalse: [msgNode args first]) emitCCodeAsArgumentOn: aStream level: level generator: self]! Item was changed: ----- Method: CCodeGenerator>>generateIfTrue:on:indent: (in category 'C translation') ----- generateIfTrue: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." (self nilOrBooleanConstantReceiverOf: msgNode) ifNil: [aStream nextPutAll: 'if ('. msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self. aStream nextPutAll: ') {'; cr. msgNode args first emitCCodeOn: aStream level: level + 1 generator: self. level timesRepeat: [ aStream tab ]. aStream nextPut: $}] + ifNotNilDo: - ifNotNil: [:const | const ifTrue: [msgNode args first emitCCodeOn: aStream level: level generator: self]]! Item was changed: ----- Method: CCodeGenerator>>generateIfTrueAsArgument:on:indent: (in category 'C translation') ----- generateIfTrueAsArgument: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." (self nilOrBooleanConstantReceiverOf: msgNode) ifNil: [aStream nextPut: $(. msgNode receiver emitCCodeAsArgumentOn: aStream level: level generator: self. aStream crtab: level + 1; nextPut: $?; space. msgNode args first emitCCodeAsArgumentOn: aStream level: level + 2 generator: self. aStream crtab: level + 1; nextPutAll: ': 0)'] + ifNotNilDo: - ifNotNil: [:const| const ifTrue: [msgNode args first emitCCodeAsArgumentOn: aStream level: level generator: self]]! Item was changed: ----- Method: CCodeGenerator>>generateIfTrueIfFalse:on:indent: (in category 'C translation') ----- generateIfTrueIfFalse: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." (self nilOrBooleanConstantReceiverOf: msgNode) ifNil: [aStream nextPutAll: 'if ('. msgNode receiver emitCCodeAsExpressionOn: aStream level: level generator: self. aStream nextPutAll: ') {'; cr. msgNode args first emitCCodeOn: aStream level: level + 1 generator: self. aStream tab: level; nextPut: $}; nextPutAll: ' else {'; cr. msgNode args last emitCCodeOn: aStream level: level + 1 generator: self. aStream tab: level; nextPut: $}] + ifNotNilDo: - ifNotNil: [:const | (const ifTrue: [msgNode args first] ifFalse: [msgNode args last]) emitCCodeOn: aStream level: level generator: self]! Item was changed: ----- Method: CCodeGenerator>>generateIfTrueIfFalseAsArgument:on:indent: (in category 'C translation') ----- generateIfTrueIfFalseAsArgument: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." (self nilOrBooleanConstantReceiverOf: msgNode) ifNil: [aStream nextPut: $(. msgNode receiver emitCCodeAsArgumentOn: aStream level: level generator: self. aStream crtab: level + 1; nextPut: $?; space. msgNode args first emitCCodeAsArgumentOn: aStream level: level + 2 generator: self. aStream crtab: level + 1; nextPut: $:; space. msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self. aStream nextPut: $)] + ifNotNilDo: - ifNotNil: [:const| (const ifTrue: [msgNode args first] ifFalse: [msgNode args last]) emitCCodeAsArgumentOn: aStream level: level generator: self]! Item was changed: ----- Method: CCodeGenerator>>generateValue:on:indent: (in category 'C translation') ----- generateValue: aTSendNode on: aStream indent: level "Reduce [:formal ... :formalN| body ] value: actual ... value: actualN to body with formals substituted for by actuals." | substitution substitutionDict newLabels | self assert: aTSendNode receiver isStmtList. self assert: aTSendNode receiver args size = aTSendNode args size. substitution := aTSendNode receiver copy. substitution renameLabelsForInliningInto: currentMethod. substitutionDict := Dictionary new: aTSendNode args size * 2. aTSendNode receiver args with: aTSendNode args do: [ :argName :exprNode | substitutionDict at: argName put: exprNode]. substitution bindVariablesIn: substitutionDict; emitCCodeOn: aStream level: level generator: self. newLabels := Set withAll: currentMethod labels. substitution nodesDo: + [:node| node isLabel ifTrue: [node label ifNotNilDo: [:label| newLabels add: label]]]. - [:node| node isLabel ifTrue: [node label ifNotNil: [:label| newLabels add: label]]]. "now add the new labels so that a subsequent inline of the same block will be renamed with different labels." currentMethod labels: newLabels! Item was changed: ----- Method: CCodeGenerator>>generateValueAsArgument:on:indent: (in category 'C translation') ----- generateValueAsArgument: aTSendNode on: aStream indent: level "Reduce [:formal ... :formalN| body ] value: actual ... value: actualN to body with formals substituted for by actuals." | substitution substitutionDict newLabels | self assert: aTSendNode receiver isStmtList. self assert: aTSendNode receiver args size = aTSendNode args size. substitution := aTSendNode receiver copy. substitution renameLabelsForInliningInto: currentMethod. substitutionDict := Dictionary new: aTSendNode args size * 2. aTSendNode receiver args with: aTSendNode args do: [ :argName :exprNode | substitutionDict at: argName put: exprNode]. substitution bindVariablesIn: substitutionDict; emitCCodeAsArgumentOn: aStream level: level generator: self. newLabels := Set withAll: currentMethod labels. substitution nodesDo: + [:node| node isLabel ifTrue: [node label ifNotNilDo: [:label| newLabels add: label]]]. - [:node| node isLabel ifTrue: [node label ifNotNil: [:label| newLabels add: label]]]. "now add the new labels so that a subsequent inline of the same block will be renamed with different labels." currentMethod labels: newLabels! Item was changed: ----- Method: CCodeGenerator>>storeCodeOnFile:doInlining:doAssertions: (in category 'public') ----- storeCodeOnFile: fileName doInlining: inlineFlag doAssertions: assertionFlag "Store C code for this code base on the given file." | stream | + stream := VMMaker forceNewFileNamed: fileName. - stream := CrLfFileStream forceNewFileNamed: fileName. stream ifNil: [Error signal: 'Could not open C code file: ', fileName]. self emitCCodeOn: stream doInlining: inlineFlag doAssertions: assertionFlag. stream close! Item was changed: ----- Method: CCodeGenerator>>storeHeaderFor:onFile: (in category 'public') ----- storeHeaderFor: interpreterClassName onFile: fileName "Store C header code for this interpreter on the given file." | aStream | + aStream := VMMaker forceNewFileNamed: fileName. - aStream := CrLfFileStream forceNewFileNamed: fileName. aStream ifNil: [Error signal: 'Could not open C header file: ', fileName]. aStream nextPutAll: '/* '; nextPutAll: VMMaker headerNotice; nextPutAll: ' */'; cr; cr; nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr; cr; nextPutAll: '#ifndef HAVE_INTERP_H'; cr; nextPutAll: '# define HAVE_INTERP_H'; cr; nextPutAll: '#endif'; cr; cr. self emitVmmVersionOn: aStream. (Smalltalk classNamed: interpreterClassName) emitInterpreterProxyVersionOn: aStream. self emitDefineBytesPerWordOn: aStream. aStream cr. aStream close ! Item was changed: ----- Method: CCodeGenerator>>var:declareC: (in category 'public') ----- var: varName declareC: declarationString "Record the given C declaration for a global variable." + (self string: declarationString includesSubstring: varName) ifFalse: - (declarationString includesSubString: varName) ifFalse: [self error: 'declaration omits variable name. probably an error. use e.g. var:type:']. variableDeclarations at: varName asString put: declarationString.! Item was changed: ----- Method: ContextInterpreter>>primitiveMemorySnapshotBytesWithHeader (in category 'snapshot utility primitives') ----- primitiveMemorySnapshotBytesWithHeader "Primitive. Answer an array with a snapshot copy of the object memory as of the point of entry to this primitive, and with the header information for the image at the point of the snapshot. The memory snapshot is a ByteArray copy of the object memory, and the header information is an array of the values that would be stored in an image file header if the image was being saved to disk. The header state information along with memory snapshot are sufficient to initialize an an image to be run in an interpreter." - <export: true> "pop rcvr. A resuming image will see this primitive answering true, otherwise it will answer the expected value of a two element array. Test for result equal to true to determine if the image is being resumed from a saved snapshot.." | result | + <export: true> self pop: argumentCount + 1. self push: objectMemory getTrueObj. "resuming image will see this" result := self headerAndSnapshotOfSize: self prepareForSnapshot class: objectMemory classByteArray. self pop: 1. "restore stack" self push: result. "normal sender will see this" ! Item was changed: ----- Method: ContextInterpreter>>primitiveMemorySnapshotWithHeader (in category 'snapshot utility primitives') ----- primitiveMemorySnapshotWithHeader "Primitive. Answer an array with a snapshot copy of the object memory as of the point of entry to this primitive, and with the header information for the image at the point of the snapshot. The memory snapshot is a Bitmap copy of the object memory, and the header information is an array of the values that would be stored in an image file header if the image was being saved to disk. The header state information along with memory snapshot are sufficient to initialize an an image to be run in an interpreter." - <export: true> "pop rcvr. A resuming image will see this primitive answering true, otherwise it will answer the expected value of a two element array. Test for result equal to true to determine if the image is being resumed from a saved snapshot.." | result | + <export: true> self pop: argumentCount + 1. + self push: objectMemory getTrueObj. "resuming image will see this" - self push: objectMemory getTrueObj. "resuming image will see this" result := self headerAndSnapshotOfSize: self prepareForSnapshot class: objectMemory classBitmap. self pop: 1. "restore stack" self push: result. "normal sender will see this" ! Item was changed: ----- Method: ContextInterpreter>>primitiveResumeFromSnapshot (in category 'snapshot utility primitives') ----- primitiveResumeFromSnapshot "Discard the current object memory and resume interpreter execution in the provided snapshot." - <export: true> | expectedArraySize snapshotValues size newMemoryBytesOrBitmap bigEndian snapshotImageFormat snapshotStartOfMemory snapshotSpecialObjectsOop snapshotLastHash screenSizePoint headerSize imageBytes imageHeaderFlags snapshotExtraVMMemory swapBytes snapshotFullScreen defaultHeapSize desiredHeapSize | + <export: true> expectedArraySize := 11. "ImageSnapshot new asValues size => 11" argumentCount == 1 ifFalse: [ ^self primitiveFailFor: PrimErrBadNumArgs]. snapshotValues := self stackObjectValue: 0. self assertClassOf: snapshotValues is: (objectMemory splObj: ClassArray). self successful ifFalse: [ ^self primitiveFailFor: PrimErrBadArgument]. size := objectMemory numSlotsOf: snapshotValues. size < expectedArraySize ifTrue: [ ^self primitiveFailFor: PrimErrBadArgument]. newMemoryBytesOrBitmap := objectMemory fetchPointer: 0 ofObject: snapshotValues. bigEndian := (objectMemory fetchPointer: 1 ofObject: snapshotValues) = objectMemory trueObject. snapshotImageFormat := objectMemory integerValueOf: (objectMemory fetchPointer: 2 ofObject: snapshotValues).. (self readableFormat: snapshotImageFormat) ifFalse: [ ^self primitiveFailFor: PrimErrInappropriate ]. headerSize := objectMemory integerValueOf: (objectMemory fetchPointer: 3 ofObject: snapshotValues).. imageBytes := self positive32BitValueOf: (objectMemory fetchPointer: 4 ofObject: snapshotValues).. "good for up to 2GB image" snapshotStartOfMemory := objectMemory integerValueOf: (objectMemory fetchPointer: 5 ofObject: snapshotValues).. snapshotSpecialObjectsOop := objectMemory integerValueOf: (objectMemory fetchPointer: 6 ofObject: snapshotValues).. snapshotLastHash := objectMemory integerValueOf: (objectMemory fetchPointer: 7 ofObject: snapshotValues).. screenSizePoint := objectMemory fetchPointer: 8 ofObject: snapshotValues.. self assertClassOf: screenSizePoint is: (objectMemory splObj: ClassPoint). self successful ifFalse: [ ^self primitiveFailFor: PrimErrBadArgument]. imageHeaderFlags := objectMemory integerValueOf: (objectMemory fetchPointer: 9 ofObject: snapshotValues).. snapshotExtraVMMemory := objectMemory integerValueOf: (objectMemory fetchPointer: 10 ofObject: snapshotValues).. swapBytes := bigEndian ~= self isBigEnder. snapshotFullScreen := false. "FIXME" "From sqUnixMain.c #define DefaultHeapSize 20 megabytes BEYOND actual image size" defaultHeapSize := 20 * 1000 * 1000. desiredHeapSize := defaultHeapSize + imageBytes. self snapshotResume: newMemoryBytesOrBitmap heapSize: desiredHeapSize swapBytes: swapBytes oldBaseAddr: snapshotStartOfMemory specialObjectsOop: snapshotSpecialObjectsOop lastHash: snapshotLastHash savedWindowSize: screenSizePoint fullScreenFlag: snapshotFullScreen extraVMMemory: snapshotExtraVMMemory. self pop: 1 thenPush: newMemoryBytesOrBitmap. ! Item was changed: ----- Method: InterpreterPlugin class>>storeString:onFileNamed: (in category 'translation') ----- storeString: s onFileNamed: fileName "Store the given string in a file of the given name." | f | + f := VMMaker forceNewFileNamed: fileName. - f := CrLfFileStream forceNewFileNamed: fileName. f nextPutAll: s. f close.! Item was changed: ----- Method: NewObjectMemorySimulator>>lookupAddress: (in category 'memory access') ----- lookupAddress: address "If address appears to be that of a Symbol or a few well-known objects (such as classes) answer it, otherwise answer nil. For code disassembly" <doNotGenerate> | fmt size string class classSize maybeThisClass classNameIndex thisClassIndex | (self addressCouldBeObj: address) ifFalse: [^nil]. fmt := self formatOf: address. size := self lengthOf: address baseHeader: (self baseHeader: address) format: fmt. size = 0 ifTrue: [^address caseOf: { [nilObj] -> ['nil']. [trueObj] -> ['true']. [falseObj] -> ['false'] } otherwise: []]. ((fmt between: 8 and: 11) "indexable byte fields" and: [(size between: 1 and: 64) and: [Scanner isLiteralSymbol: (string := (0 to: size - 1) collect: [:i| Character value: (self fetchByte: i ofObject: address)])]]) ifTrue: [^'#', (ByteString withAll: string)]. class := self fetchClassOfNonInt: address. ((self addressCouldBeObj: class) and: [(self headerType: class) ~= HeaderTypeShort]) ifFalse: [^nil]. "address is either a class or a metaclass, or an instance of a class or invalid. determine which." classNameIndex := coInterpreter classNameIndex. thisClassIndex := coInterpreter thisClassIndex. ((classSize := self lengthOf: class baseHeader: (self baseHeader: address) format: fmt) <= (classNameIndex max: thisClassIndex) or: [classSize > 255]) ifTrue: [^nil]. "Address could be a class or a metaclass" (fmt = 1 and: [size >= classNameIndex]) ifTrue: ["Is address a class? If so class's thisClass is address." + (self lookupAddress: (self fetchPointer: classNameIndex ofObject: address)) ifNotNilDo: - (self lookupAddress: (self fetchPointer: classNameIndex ofObject: address)) ifNotNil: [:maybeClassName| (self fetchPointer: thisClassIndex ofObject: class) = address ifTrue: [^maybeClassName allButFirst]]. "Is address a Metaclass? If so class's name is Metaclass and address's thisClass holds the class name" ((self isBytes: (self fetchPointer: classNameIndex ofObject: class)) and: [(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) = '#Metaclass' and: [size >= thisClassIndex]]) ifTrue: [maybeThisClass := self fetchPointer: thisClassIndex ofObject: address. (self lookupAddress: (self fetchPointer: classNameIndex ofObject: maybeThisClass)) ifNotNil: [:maybeThisClassName| ^maybeThisClassName allButFirst, ' class']]]. ^(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) ifNotNil: [:maybeClassName| 'a(n) ', maybeClassName allButFirst]! Item was added: + ----- Method: Object>>string:includesSubstring: (in category '*VMMaker-translation support') ----- + string: aString includesSubstring: substring + "Backward compatibility for a method that was renamed but needs to + remain functional for VMMaker across a range of images." + + ^ (aString respondsTo: #includesSubstring: ) + ifTrue: [aString perform: #includesSubstring: with: substring] + ifFalse: [aString perform: #includesSubString: with: substring] + ! Item was changed: ----- Method: SlangTest>>testInterpDeclareStatic (in category 'testing interpreter') ----- testInterpDeclareStatic "A static directive should cause the generated function to be declared static." | stssi m1 p1 m2 p2 | stssi := SlangTestSupportInterpreter inline: false. m1 := (stssi asCString: #declareStaticTrueByMethod) copyReplaceAll: 'declareStaticTrueByMethod' with: 'methodName'. p1 := (stssi asCString: #declareStaticTrueByPragma) copyReplaceAll: 'declareStaticTrueByPragma' with: 'methodName'. self assert: m1 = p1. m2 := (stssi asCString: #declareStaticFalseByMethod) copyReplaceAll: 'declareStaticFalseByMethod' with: 'methodName'. p2 := (stssi asCString: #declareStaticFalseByPragma) copyReplaceAll: 'declareStaticFalseByPragma' with: 'methodName'. self assert: m2 = p2. "verify that the keyword 'static appears in the generated C source" + self assert: (self string: m1 includesSubstring: 'static'). + self assert: (self string: p1 includesSubstring: 'static'). + self deny: (self string: m2 includesSubstring: 'static'). + self deny: (self string: p2 includesSubstring: 'static') - self assert: (m1 includesSubString: 'static'). - self assert: (p1 includesSubString: 'static'). - self deny: (m2 includesSubString: 'static'). - self deny: (p2 includesSubString: 'static') ! Item was changed: ----- Method: SlangTest>>testInterpDoNotdoNotGenerateByMethod (in category 'testing interpreter') ----- testInterpDoNotdoNotGenerateByMethod "A doNotdoNotGenerate statement should prevent code generation" "(SlangTest selector: #testInterpDoNotdoNotGenerateByMethod) debug" | stssi m | stssi := SlangTestSupportInterpreter inline: false. self assert: (SlangTestSupportInterpreter canUnderstand: #doNotGenerateByMethod). m := stssi asCString: #doNotGenerateByMethod. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stssi asCString includesSubstring: 'doNotGenerateByMethod'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stssi asCString includesSubString: 'doNotGenerateByMethod'). self assert: (stssi doNotGenerateByMethod = 4) ! Item was changed: ----- Method: SlangTest>>testInterpDoNotdoNotGenerateByPragma (in category 'testing interpreter') ----- testInterpDoNotdoNotGenerateByPragma "A <doNotdoNotGenerate> declaration should prevent code generation" | stssi m | stssi := SlangTestSupportInterpreter inline: false. self assert: (SlangTestSupportInterpreter canUnderstand: #doNotGenerateByPragma). m := stssi asCString: #doNotGenerateByPragma. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stssi asCString includesSubstring: 'doNotGenerateByPragma'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stssi asCString includesSubString: 'doNotGenerateByPragma'). self assert: (stssi doNotGenerateByPragma = 4) ! Item was changed: ----- Method: SlangTest>>testInterpDoNotdoNotGenerateSubclassResponsibility (in category 'testing interpreter') ----- testInterpDoNotdoNotGenerateSubclassResponsibility "If a method contains self subclassResponsibility, assume it is not meant for translation." | stssi m | stssi := SlangTestSupportInterpreter inline: false. self assert: (SlangTestSupportInterpreter canUnderstand: #anAbstractMethod). m := stssi asCString: #anAbstractMethod. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stssi asCString includesSubstring: 'anAbstractMethod'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stssi asCString includesSubString: 'anAbstractMethod'). self should: [stssi anAbstractMethod] raise: Error ! Item was changed: ----- Method: SlangTest>>testInterpMixedMethodAndPragmaDeclarations (in category 'testing interpreter') ----- testInterpMixedMethodAndPragmaDeclarations "Pragmas and method declarations should coexist" | stssi s | stssi := SlangTestSupportInterpreter inline: false. s := (stssi asCString: #varDefByMethodAndPragma) copyReplaceAll: 'varDefByMethod' with: 'methodName'. + self assert: (self string: s includesSubstring: 'unsigned int * bar'). + self assert: (self string: s includesSubstring: 'char *foo'). + self assert: (self string: s includesSubstring: 'float baz'). + self assert: (self string: s includesSubstring: 'double fum'). - self assert: (s includesSubString: 'unsigned int * bar'). - self assert: (s includesSubString: 'char *foo'). - self assert: (s includesSubString: 'float baz'). - self assert: (s includesSubString: 'double fum'). ! Item was changed: ----- Method: SlangTest>>testIvarShouldNotBeRedeclaredAsLocal (in category 'testing variable declaration') ----- testIvarShouldNotBeRedeclaredAsLocal "Document a bug in some versions of the code generator. If an instance variable is referenced in the generated code, that variable should not be declared as a local in the function." | stssi s | stssi := SlangTestSupportInterpreter inline: false. s := stssi asCString: #setBreakSelector: . + self deny: (self string: s includesSubstring: 'sqInt breakSelector;') - self deny: (s includesSubString: 'sqInt breakSelector;') ! Item was changed: ----- Method: SlangTest>>testLiteralName (in category 'testing variable declaration') ----- testLiteralName "sizeOf: #Foo should translated to C function call sizeof(Foo), where Foo is a literal, not a string" | stssi s | stssi := SlangTestSupportInterpreter inline: false. s := stssi asCString: #sizeOfFoo . + self assert: (self string: s includesSubstring: 'sizeOf(Foo)'). + self deny: (self string: s includesSubstring: 'sizeOf("Foo")'). - self assert: (s includesSubString: 'sizeOf(Foo)'). - self deny: (s includesSubString: 'sizeOf("Foo")'). ! Item was changed: ----- Method: SlangTest>>testLocalizeGlobalVariables (in category 'testing variable declaration') ----- testLocalizeGlobalVariables "CCodeGenerator>>localizeGlobalVariables performs an optimization that may be misleading when introducing a new method. This test documents that optimization. If a method makes reference to an instance variable, and if this is the only method containing a reference to that variable, then the C translator will produce a local variable declaration in the generated function, and no global declaration will appear in the generated source file. This optimization is applied after inlining has been performed, so there are legitimate cases where a variable must be an instance variable referenced by two methods, but can be made local if those methods are inlined into a single method and only one method reference to the variable remains. See ObjectMemory>>markAndSweep: for an example." | stssi s | stssi := SlangTestSupportInterpreter inline: false. s := stssi asCString: #methodWithReferenceToVariables . "variable with one method reference is promoted to a local method variable" + self assert: (self string: s includesSubstring: 'sqInt aVarWithOneReference;'). - self assert: (s includesSubString: 'sqInt aVarWithOneReference;'). "normal expected behavior, the variable is global in the generated source module." + self deny: (self string: s includesSubstring: 'sqInt aVarWithTwoReferences;') - self deny: (s includesSubString: 'sqInt aVarWithTwoReferences;') ! Item was changed: ----- Method: SlangTest>>testPluginDeclareStatic (in category 'testing base plugins') ----- testPluginDeclareStatic "A static directive should cause the generated function to be declared static." | stsp m1 p1 m2 p2 | stsp := SlangTestSupportPlugin inline: false. m1 := (stsp asCString: #declareStaticTrueByMethod) copyReplaceAll: 'declareStaticTrueByMethod' with: 'methodName'. p1 := (stsp asCString: #declareStaticTrueByPragma) copyReplaceAll: 'declareStaticTrueByPragma' with: 'methodName'. self assert: m1 = p1. m2 := (stsp asCString: #declareStaticFalseByMethod) copyReplaceAll: 'declareStaticFalseByMethod' with: 'methodName'. p2 := (stsp asCString: #declareStaticFalseByPragma) copyReplaceAll: 'declareStaticFalseByPragma' with: 'methodName'. self assert: m2 = p2. "verify that the keyword 'static appears in the generated C source" + self assert: (self string: m1 includesSubstring: 'static'). + self assert: (self string: p1 includesSubstring: 'static'). + self deny: (self string: m2 includesSubstring: 'static'). + self deny: (self string: p2 includesSubstring: 'static') - self assert: (m1 includesSubString: 'static'). - self assert: (p1 includesSubString: 'static'). - self deny: (m2 includesSubString: 'static'). - self deny: (p2 includesSubString: 'static') ! Item was changed: ----- Method: SlangTest>>testPluginDoNotGenerateByMethod (in category 'testing base plugins') ----- testPluginDoNotGenerateByMethod "A doNotdoNotGenerate statement should prevent code generation" | stsp m | stsp := SlangTestSupportPlugin inline: false. self assert: (SlangTestSupportPlugin canUnderstand: #doNotGenerateByMethod). m := stsp asCString: #doNotGenerateByMethod. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stsp asCString includesSubstring: 'doNotGenerateByMethod'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stsp asCString includesSubString: 'doNotGenerateByMethod'). self assert: (stsp doNotGenerateByMethod = 4) ! Item was changed: ----- Method: SlangTest>>testPluginDoNotGenerateByPragma (in category 'testing base plugins') ----- testPluginDoNotGenerateByPragma "A <doNotdoNotGenerate> declaration should prevent code generation" | stsp m | stsp := SlangTestSupportPlugin inline: false. self assert: (SlangTestSupportPlugin canUnderstand: #doNotGenerateByPragma). m := stsp asCString: #doNotGenerateByPragma. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stsp asCString includesSubstring: 'doNotGenerateByPragma'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stsp asCString includesSubString: 'doNotGenerateByPragma'). self assert: (stsp doNotGenerateByPragma = 4) ! Item was changed: ----- Method: SlangTest>>testPluginDoNotGenerateSubclassResponsibility (in category 'testing base plugins') ----- testPluginDoNotGenerateSubclassResponsibility "If a method contains self subclassResponsibility, assume it is not meant for translation." | stsp m | stsp := SlangTestSupportPlugin inline: false. self assert: (SlangTestSupportPlugin canUnderstand: #anAbstractMethod). m := stsp asCString: #anAbstractMethod. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stsp asCString includesSubstring: 'anAbstractMethod'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stsp asCString includesSubString: 'anAbstractMethod'). self should: [stsp anAbstractMethod] raise: Error ! Item was changed: ----- Method: SlangTest>>testPluginMixedMethodAndPragmaDeclarations (in category 'testing base plugins') ----- testPluginMixedMethodAndPragmaDeclarations "Pragmas and method declarations should coexist" | stsp s | stsp := SlangTestSupportPlugin inline: false. s := (stsp asCString: #varDefByMethodAndPragma) copyReplaceAll: 'varDefByMethod' with: 'methodName'. + self assert: (self string: s includesSubstring: 'unsigned int * bar'). + self assert: (self string: s includesSubstring: 'char *foo'). + self assert: (self string: s includesSubstring: 'float baz'). + self assert: (self string: s includesSubstring: 'double fum'). - self assert: (s includesSubString: 'unsigned int * bar'). - self assert: (s includesSubString: 'char *foo'). - self assert: (s includesSubString: 'float baz'). - self assert: (s includesSubString: 'double fum'). ! Item was changed: ----- Method: SlangTest>>testSSIPDeclareStatic (in category 'testing ssip plugins') ----- testSSIPDeclareStatic "A static directive should cause the generated function to be declared static." | stss m1 p1 m2 p2 | stss := SlangTestSupportSSIP inline: false. m1 := (stss asCString: #declareStaticTrueByMethod) copyReplaceAll: 'declareStaticTrueByMethod' with: 'methodName'. p1 := (stss asCString: #declareStaticTrueByPragma) copyReplaceAll: 'declareStaticTrueByPragma' with: 'methodName'. self assert: m1 = p1. m2 := (stss asCString: #declareStaticFalseByMethod) copyReplaceAll: 'declareStaticFalseByMethod' with: 'methodName'. p2 := (stss asCString: #declareStaticFalseByPragma) copyReplaceAll: 'declareStaticFalseByPragma' with: 'methodName'. self assert: m2 = p2. "verify that the keyword 'static appears in the generated C source" + self assert: (self string: m1 includesSubstring: 'static'). + self assert: (self string: p1 includesSubstring: 'static'). + self deny: (self string: m2 includesSubstring: 'static'). + self deny: (self string: p2 includesSubstring: 'static') - self assert: (m1 includesSubString: 'static'). - self assert: (p1 includesSubString: 'static'). - self deny: (m2 includesSubString: 'static'). - self deny: (p2 includesSubString: 'static') ! Item was changed: ----- Method: SlangTest>>testSSIPDoNotGenerateByMethod (in category 'testing ssip plugins') ----- testSSIPDoNotGenerateByMethod "A doNotdoNotGenerate statement should prevent code generation" | stss m | stss := SlangTestSupportSSIP inline: false. self assert: (SlangTestSupportSSIP canUnderstand: #doNotGenerateByMethod). m := stss asCString: #doNotGenerateByMethod. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stss asCString includesSubstring: 'doNotGenerateByMethod'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stss asCString includesSubString: 'doNotGenerateByMethod'). self assert: (stss doNotGenerateByMethod = 4)! Item was changed: ----- Method: SlangTest>>testSSIPDoNotGenerateByPragma (in category 'testing ssip plugins') ----- testSSIPDoNotGenerateByPragma "A <doNotdoNotGenerate> declaration should prevent code generation" | stss m | stss := SlangTestSupportSSIP inline: false. self assert: (SlangTestSupportSSIP canUnderstand: #doNotGenerateByPragma). m := stss asCString: #doNotGenerateByPragma. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stss asCString includesSubstring: 'doNotGenerateByPragma'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stss asCString includesSubString: 'doNotGenerateByPragma'). self assert: (stss doNotGenerateByPragma = 4) ! Item was changed: ----- Method: SlangTest>>testSSIPDoNotGenerateSubclassResponsibility (in category 'testing ssip plugins') ----- testSSIPDoNotGenerateSubclassResponsibility "If a method contains self subclassResponsibility, assume it is not meant for translation." | stss m | stss := SlangTestSupportSSIP inline: false. self assert: (SlangTestSupportSSIP canUnderstand: #anAbstractMethod). m := stss asCString: #anAbstractMethod. + self assert: (self string: m includesSubstring: 'No source has been generated'). + self deny: (self string: stss asCString includesSubstring: 'anAbstractMethod'). - self assert: (m includesSubString: 'No source has been generated'). - self deny: (stss asCString includesSubString: 'anAbstractMethod'). self should: [stss anAbstractMethod] raise: Error ! Item was changed: ----- Method: SlangTest>>testSSIPMixedMethodAndPragmaDeclarations (in category 'testing ssip plugins') ----- testSSIPMixedMethodAndPragmaDeclarations "Pragmas and method declarations should coexist" | stss s | stss := SlangTestSupportSSIP inline: false. s := (stss asCString: #varDefByMethodAndPragma) copyReplaceAll: 'varDefByMethod' with: 'methodName'. + self assert: (self string: s includesSubstring: 'unsigned int * bar'). + self assert: (self string: s includesSubstring: 'char *foo'). + self assert: (self string: s includesSubstring: 'float baz'). + self assert: (self string: s includesSubstring: 'double fum'). - self assert: (s includesSubString: 'unsigned int * bar'). - self assert: (s includesSubString: 'char *foo'). - self assert: (s includesSubString: 'float baz'). - self assert: (s includesSubString: 'double fum'). ! Item was changed: ----- Method: SlangTest>>testSetInstanceVariableWithAnAccessorMethod (in category 'testing intermediate variable removal') ----- testSetInstanceVariableWithAnAccessorMethod "Intermediate variable from parameter of accessor method should be removed. This is an existing limitation of the inliner, and could be improved for better code generation. It is not a bug." | stssi s | stssi := SlangTestSupportInterpreter inline: true. s := (stssi asCString: #setInstanceVariableWithAnAccessorMethod) copyReplaceAll: 'setInstanceVariableWithAnAccessorMethod' with: 'methodName'. + self deny: (self string: s includesSubstring: 'sqInt oop'). + self assert: (self string: s includesSubstring: 'aVariable = remap('). - self deny: (s includesSubString: 'sqInt oop'). - self assert: (s includesSubString: 'aVariable = remap('). "Should be translated to something similar to this: aVariable = remap(objectMemory, nilObj); Not like this: oop = remap(objectMemory, nilObj); aVariable = oop;" ! Item was changed: ----- Method: SmartSyntaxPluginSimulator>>computeSignatureFor:from: (in category 'initialize') ----- computeSignatureFor: selector from: tuple | signature | self assert: tuple first == #forMap. signature := tuple third collect: [:className| (Smalltalk classNamed: className) ifNil: [self error: 'Argument class' , className, ' does not exist'] + ifNotNilDo: - ifNotNil: [:argClass| argClass ccg: self prolog: true expr: [interpreterProxy primitiveFail] index: nil]]. ^signatureMap at: tuple second asSymbol put: { selector. signature. tuple fourth ifNil: [[:oop| oop]] + ifNotNilDo: - ifNotNil: [:rcvrClassSymbol| (Smalltalk classNamed: rcvrClassSymbol) ifNil: [self error: 'Receiver class' , rcvrClassSymbol, ' does not exist'] + ifNotNilDo: - ifNotNil: [:rcvrClass| rcvrClass ccg: self prolog: false expr: [interpreterProxy primitiveFail] index: nil]] }! Item was changed: ----- Method: SmartSyntaxPluginSimulator>>computeSignatureMap (in category 'initialize') ----- computeSignatureMap forMap := true. "true only while we compute the signatureMap" signatureMap := Dictionary new. actualPlugin class selectorsAndMethodsDo: [:s :m| (m messages includesAnyOf: #(primitive:parameters: primitive:parameters:receiver:)) ifTrue: [self getPrimitiveSignatureFor: s] ifFalse: + [(m pragmaAt: #export:) ifNotNilDo: - [(m pragmaAt: #export:) ifNotNil: [:exportPragma| (exportPragma argumentAt: 1) ifTrue: [self computeSignatureFor: s from: { #forMap. s. #(). nil }]]]]. forMap := false! Item was changed: ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses" aCCodeGenerator addHeaderFile:'<stddef.h> /* for e.g. alloca */'; addHeaderFile:'<setjmp.h>'; addHeaderFile:'"vmCallback.h"'. self declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'. aCCodeGenerator var: #interpreterProxy type: #'struct VirtualMachine*'. aCCodeGenerator declareVar: #sendTrace type: 'volatile int'; declareVar: #byteCount type: 'unsigned long'. "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 stackMemory) as: #'char *' in: aCCodeGenerator. self declareC: #(stackPage overflowedPage) as: #'StackPage *' in: aCCodeGenerator. aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code." aCCodeGenerator var: #methodCache declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'. aCCodeGenerator var: #atCache declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'. self primitiveTable do: [:symbolOrNot| (symbolOrNot isSymbol and: [symbolOrNot ~~ #primitiveFail]) ifTrue: + [(aCCodeGenerator methodNamed: symbolOrNot) ifNotNilDo: - [(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil: [:tMethod| tMethod returnType: #void]]]. aCCodeGenerator var: #primitiveFunctionPointer declareC: 'void (*primitiveFunctionPointer)()'. aCCodeGenerator var: #showSurfaceFn type: #'void *'. aCCodeGenerator var: #jmpBuf declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. aCCodeGenerator var: #suspendedCallbacks declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. aCCodeGenerator var: #suspendedMethods declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. aCCodeGenerator var: #interruptCheckChain declareC: 'void (*interruptCheckChain)(void) = 0'. aCCodeGenerator var: #breakSelector type: #'char *'; var: #breakSelectorLength declareC: 'sqInt breakSelectorLength = -1'. self declareC: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs) as: #usqLong in: aCCodeGenerator. aCCodeGenerator var: #nextProfileTick type: #sqLong. aCCodeGenerator var: #primitiveTable declareC: 'void (*primitiveTable[' , (MaxPrimitiveIndex + 2) printString , '] )(void)= ' , self primitiveTableString. aCCodeGenerator var: #externalPrimitiveTable declareC: 'void (*externalPrimitiveTable[' , (MaxExternalPrimitiveTableSize + 1) printString , '])(void)'. ! Item was changed: ----- Method: StackInterpreter class>>table:from: (in category 'initialization') ----- table: anArray from: specArray "SpecArray is an array of one of (index selector) or (index1 index2 selector) or (index nil) or (index1 index2 nil). If selector then the entry is the selector, but if nil the entry is the index." | contiguous | contiguous := 0. specArray do: [:spec | (spec at: 1) = contiguous ifFalse: [self error: 'Non-contiguous table entry']. spec size = 2 ifTrue: [anArray at: (spec at: 1) + 1 + put: ((spec at: 2) ifNil: [spec at: 1] ifNotNilDo: [:sym| sym]). - put: ((spec at: 2) ifNil: [spec at: 1] ifNotNil: [:sym| sym]). contiguous := contiguous + 1] ifFalse: [(spec at: 1) to: (spec at: 2) do: + [:i | anArray at: i + 1 put: ((spec at: 3) ifNil: [i] ifNotNilDo: [:sym| sym])]. - [:i | anArray at: i + 1 put: ((spec at: 3) ifNil: [i] ifNotNil: [:sym| sym])]. contiguous := contiguous + ((spec at: 2) - (spec at: 1)) + 1]]! Item was changed: ----- Method: StackInterpreterSimulator>>run (in category 'testing') ----- run "Just run" quitBlock := [([transcript dependents anyOne outermostMorphThat: [:m| m isSystemWindow]] on: Error do: [:ex| nil]) + ifNotNilDo: [:window| (UIManager default confirm: 'close?') ifTrue: [window delete]]. - ifNotNil: [:window| (UIManager default confirm: 'close?') ifTrue: [window delete]]. ^self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. atEachStepBlock value. "N.B. may be nil" self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. localIP := localIP - 1. "undo the pre-increment of IP before returning" self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') ----- runWithBreakCount: theBreakCount "Just run, halting when byteCount is reached" quitBlock := [(displayView notNil and: [UIManager default confirm: 'close?']) ifTrue: + [(displayView outermostMorphThat: [:m| m isSystemWindow]) ifNotNilDo: - [(displayView outermostMorphThat: [:m| m isSystemWindow]) ifNotNil: [:topWindow| topWindow delete]]. ^self]. breakCount := theBreakCount. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. localIP := localIP - 1. "undo the pre-increment of IP before returning" self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') ----- utilitiesMenu: aMenuMorph aMenuMorph add: 'toggle transcript' action: #toggleTranscript; addLine; add: 'print ext head frame' action: #printExternalHeadFrame; add: 'print int head frame' action: #printHeadFrame; add: 'short print frame & callers' action: [self shortPrintFrameAndCallers: framePointer]; add: 'long print frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer]; + add: 'print frame...' target: self action: [(self promptHex: 'print frame') ifNotNilDo: [:fp| self printFrame: fp]]; - add: 'print frame...' target: self action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]]; add: 'print call stack' action: #printCallStack; + add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNilDo: [:oop| self printOop: oop]]; - add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]]; addLine; add: 'inspect object memory' target: objectMemory action: #inspect; add: 'inspect cointerpreter' action: #inspect; addLine; add: 'set break count...' action: #setBreakCount; add: (printSends ifTrue: ['no print sends'] ifFalse: ['print sends']) action: [self ensureDebugAtEachStepBlock. printSends := printSends not]; "currently printReturns does nothing" "add: (printReturns ifTrue: ['no print returns'] ifFalse: ['print returns']) action: [self ensureDebugAtEachStepBlock. printReturns := printReturns not];" add: (printBytecodeAtEachStep ifTrue: ['no print bytecode each bytecode'] ifFalse: ['print bytecode each bytecode']) action: [self ensureDebugAtEachStepBlock. printBytecodeAtEachStep := printBytecodeAtEachStep not]; add: (printFrameAtEachStep ifTrue: ['no print frame each bytecode'] ifFalse: ['print frame each bytecode']) action: [self ensureDebugAtEachStepBlock. printFrameAtEachStep := printFrameAtEachStep not]. ^aMenuMorph! Item was changed: ----- Method: TCaseStmtNode>>assumesCurrentBytecodeMatchesCaseValue: (in category 'as yet unclassified') ----- assumesCurrentBytecodeMatchesCaseValue: statementList "Test for the special case of certain methods that rely on the value of the currentBytecode variable to be expanded to a constant. This is a performance optimization that permits the next bytecode to be fetched early while not affecting the prior value of currentBytecode, which will have been translated to a constant. See senders of #'requires currentBytecode to be expanded to a constant' for methods that rely on this behavior." | trickySelectors commentString firstLine | trickySelectors := { #pushLiteralConstantBytecode . #pushLiteralVariableBytecode . #pushReceiverVariableBytecode . #pushTemporaryVariableBytecode . #storeAndPopTemporaryVariableBytecode . #storeAndPopReceiverVariableBytecode }. firstLine := statementList statements first. firstLine isComment ifTrue: [ commentString := firstLine asString. + trickySelectors detect: [:e | self string: commentString includesSubstring: e] - trickySelectors detect: [:e | commentString includesSubString: e] ifNone: [^ false]. ^ true]. ^ false! Item was changed: ----- Method: TMethod>>addTypeForSelf (in category 'utilities') ----- addTypeForSelf "If self should be typed then add a suitable type declaration. Preserve the flagging of an implicit self using the #implicit symbol as the fake type." + self typeForSelf ifNotNilDo: - self typeForSelf ifNotNil: [:typeForSelf| self declarationAt: 'self' put: (typeForSelf == #implicit ifTrue: [typeForSelf] ifFalse: [typeForSelf, ' self'])]! Item was changed: ----- Method: TMethod>>argConversionExprFor:stackIndex: (in category 'primitive compilation') ----- argConversionExprFor: varName stackIndex: stackIndex "Return the parse tree for an expression that fetches and converts the primitive argument at the given stack offset." | exprList decl stmtList | exprList := OrderedCollection new. (declarations includesKey: varName) ifTrue:[ decl := declarations at: varName. (decl includes: $*) ifTrue:["array" + (self string: decl includesSubstring: 'char') ifTrue:[ | expr | - (decl includesSubString: 'char') ifTrue:[ | expr | expr := '(interpreterProxy isBytes: (interpreterProxy stackValue: (stackIndex))) ifFalse:[^interpreterProxy primitiveFail].'. expr := expr copyReplaceAll: 'interpreterProxy' with: self vmNameString. expr := expr copyReplaceAll: 'stackIndex' with: stackIndex printString. exprList add: expr. ]. exprList add: varName , ' := ', self vmNameString, ' arrayValueOf: (', self vmNameString, ' stackValue: (' , stackIndex printString , '))'. exprList add: varName , ' := ' , varName , ' - 1'. ] ifFalse:["must be a double" (decl findString: 'double' startingAt: 1) = 0 ifTrue: [ self error: 'unsupported type declaration in a primitive method' ]. exprList add: varName , ' := ', self vmNameString, ' stackFloatValue: ' , stackIndex printString. ] ] ifFalse: ["undeclared variables are taken to be integer" exprList add: varName , ' := ', self vmNameString, ' stackIntegerValue: ' , stackIndex printString ]. stmtList := OrderedCollection new. exprList do: [:e | stmtList addAll: (self statementsFor: e varName: varName)]. ^ stmtList! Item was changed: ----- Method: TMethod>>emitCFunctionPrototype:generator:newlineBeforeName: (in category 'C code generation') ----- emitCFunctionPrototype: aStream generator: aCodeGen newlineBeforeName: newlineBeforeName "<Boolean>" "Emit a C function header for this method onto the given stream." export ifTrue:[aStream nextPutAll: 'EXPORT('; nextPutAll: returnType; nextPut: $)] ifFalse:[(self isStaticIn: aCodeGen) ifTrue:[aStream nextPutAll: 'static ']. aStream nextPutAll: returnType]. newlineBeforeName ifTrue: [aStream cr] ifFalse: [aStream space]. (returnType last = $) + and: [self string: returnType includesSubstring: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration)]) ifTrue: - and: [returnType includesSubString: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration)]) ifTrue: ["Hack fix for e.g. <returnTypeC: 'void (*setInterruptCheckChain(void (*aFunction)(void)))()'>" ^self]. aStream nextPutAll: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration); nextPut: $(. args isEmpty ifTrue: [aStream nextPutAll: #void] ifFalse: [args do: [:arg| aStream nextPutAll: (self declarationAt: arg)] separatedBy: [ aStream nextPutAll: ', ' ]]. aStream nextPut: $)! Item was changed: ----- Method: TMethod>>extractDirective:valueBlock:default: (in category 'transformations') ----- extractDirective: theSelector valueBlock: aBlock default: defaultResult "Find a pragma of the form: <theSelector[args]> Answer the result of evaluating aBock with a TSendNode corresponding to the pragma node, or defaultResult if there is no matching pragma." | result found newStatements | + (properties at: theSelector ifAbsent: []) ifNotNilDo: - (properties at: theSelector ifAbsent: []) ifNotNil: [:pragma| ^aBlock value: (TSendNode new setSelector: pragma keyword receiver: (TVariableNode new setName: 'self') arguments: (pragma arguments collect: [:const| TConstantNode new setValue: const]))]. "Pre-pragma backward compatibility: Scan the top-level statements for a labelling directive of the form: self theSelector[args] and remove the directive from the method body if found. Answer the result of evaluating aBock with the send node, or defaultResult if there is no labelling directive." result := defaultResult. found := false. newStatements := OrderedCollection new: parseTree statements size. parseTree statements do: [ :stmt | (stmt isSend and: [stmt selector = theSelector]) ifTrue: [found := true. result := aBlock value: stmt] ifFalse: [newStatements add: stmt]]. ^found ifTrue: [parseTree setStatements: newStatements asArray. result] ifFalse: [defaultResult]! Item was changed: ----- Method: TMethod>>maybeBreakFor:in: (in category 'inlining') ----- maybeBreakFor: aNode in: aCodeGen "convenient for debugging..." (aNode isSend and: [(aCodeGen breakSrcInlineSelector notNil or: [aCodeGen breakDestInlineSelector notNil]) + and: [(aCodeGen breakSrcInlineSelector ifNil: [true] ifNotNilDo: [:srcSel| srcSel = aNode selector]) + and: [aCodeGen breakDestInlineSelector ifNil: [true] ifNotNilDo: [:dstSel| dstSel = selector]]]]) ifTrue: - and: [(aCodeGen breakSrcInlineSelector ifNil: [true] ifNotNil: [:srcSel| srcSel = aNode selector]) - and: [aCodeGen breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = selector]]]]) ifTrue: [self halt: selector]! Item was changed: ----- Method: TMethod>>superExpansionNodeFor:args: (in category 'inlining') ----- superExpansionNodeFor: aSelector args: argumentNodes "Answer the expansion of a super send. Merge the super expansion's locals, properties and comment into this method's properties." (definingClass superclass lookupSelector: aSelector) ifNil: [self error: 'superclass does not define super method'] + ifNotNilDo: - ifNotNil: [:superMethod| | superTMethod commonVars varMap | superTMethod := superMethod methodNode asTranslationMethodOfClass: self class. ((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode]) and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse: [self error: definingClass name, '>>',selector, ' args ~= ', superTMethod definingClass name, '>>', aSelector, (String with: $. with: Character cr), 'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.']. self mergePropertiesOfSuperMethod: superTMethod. (commonVars := superTMethod locals intersection: self locals) notEmpty ifTrue: [varMap := Dictionary new. commonVars do: [:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)]. superTMethod renameVariablesUsing: varMap]. self assert: (superTMethod locals allSatisfy: [:var| (self locals includes: var) not]). locals addAll: superTMethod locals. superTMethod declarations keysAndValuesDo: [:var :decl| self declarationAt: var put: decl]. + superTMethod comment ifNotNilDo: - superTMethod comment ifNotNil: [:superComment| comment := comment ifNil: [superComment] + ifNotNilDo: [superComment, comment]]. + superTMethod extraVariableNumber ifNotNilDo: - ifNotNil: [superComment, comment]]. - superTMethod extraVariableNumber ifNotNil: [:scvn| extraVariableNumber := extraVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]]. superTMethod elideAnyFinalReturn. ^superTMethod parseTree]! Item was changed: ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') ----- tryToInlineMethodsIn: aCodeGen "Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined." | stmtLists didSomething newStatements sendsToInline | self definedAsMacro ifTrue: [complete := true. ^false]. didSomething := false. sendsToInline := Dictionary new: 100. parseTree nodesDo: [:node| (self inlineableFunctionCall: node in: aCodeGen) ifTrue: [sendsToInline at: node put: (self inlineFunctionCall: node in: aCodeGen)]] unless: "Don't inline the arguments to asserts to keep the asserts readable" [:node| node isSend and: [aCodeGen isAssertSelector: node selector]]. sendsToInline isEmpty ifFalse: [didSomething := true. self removeUnreferencedDeclarations. parseTree := parseTree replaceNodesIn: sendsToInline]. didSomething ifTrue: [writtenToGlobalVarsCache := nil. ^didSomething]. stmtLists := self statementsListsForInliningIn: aCodeGen. stmtLists do: [:stmtList| newStatements := OrderedCollection new: 100. stmtList statements do: [:stmt| (self inlineCodeOrNilForStatement: stmt in: aCodeGen) ifNil: [newStatements addLast: stmt] + ifNotNilDo: [:inlinedStmts| - ifNotNil: [:inlinedStmts| didSomething := true. newStatements addAllLast: inlinedStmts]]. stmtList setStatements: newStatements asArray]. didSomething ifTrue: [writtenToGlobalVarsCache := nil. ^didSomething]. complete ifFalse: [self checkForCompleteness: stmtLists in: aCodeGen. complete ifTrue: [ didSomething := true ]]. "marking a method complete is progress" ^didSomething! Item was changed: ----- Method: TSendNode>>isStructSend: (in category 'testing') ----- isStructSend: aCodeGen "Answer if the recever is a send of a structure accessor. This is tricky. We want foo bar => foo->bar foo bar => foo.bar foo bar: expr => foo->bar = expr foo bar: expr => foo.bar = expr depending on whether foo is a struct or a pointer to a struct, but only if both foo is a struct type and bar is a field accessor. The tricky cases are self-sends within struct class methods. Here we need to distinguish between self-sends of ordinary methods from self sends of accessors." ^arguments size <= 1 and: [(receiver structTargetKind: aCodeGen) notNil and: [(aCodeGen methodNamed: selector) ifNil: [false] + ifNotNilDo: [:method| method isStructAccessor]]]! - ifNotNil: [:method| method isStructAccessor]]]! Item was changed: ----- Method: TSendNode>>isStructSendIn: (in category 'testing') ----- isStructSendIn: aCodeGen "Answer if the recever is a send of a structure accessor. This is tricky. We want foo bar => foo->bar foo bar => foo.bar foo bar: expr => foo->bar = expr foo bar: expr => foo.bar = expr depending on whether foo is a struct or a pointer to a struct, but only if both foo is a struct type and bar is a field accessor. The tricky cases are self-sends within struct class methods. Here we need to distinguish between self-sends of ordinary methods from self sends of accessors." ^arguments size <= 1 and: [(receiver structTargetKindIn: aCodeGen) notNil and: [(aCodeGen methodNamed: selector) ifNil: [false] + ifNotNilDo: [:method| method isStructAccessor]]]! - ifNotNil: [:method| method isStructAccessor]]]! Item was changed: ----- Method: TSendNode>>structTargetKindIn: (in category 'testing') ----- structTargetKindIn: aCodeGen "Answer if the recever evaluates to a struct or struct pointer and hence can be dereferenced using . or ->. Answer any of #struct #pointer or nil. Right now we don't need or support structure return so this method answers either #pointer or nil." selector == #cCoerceSimple:to: ifTrue: [^(VMStructType isTypePointerToStruct: arguments last value) ifTrue: [#pointer]]. selector == #addressOf: ifTrue: [^#pointer]. selector == #at: ifTrue: [receiver isVariable ifTrue: + [(aCodeGen typeOfVariable: receiver name) ifNotNilDo: - [(aCodeGen typeOfVariable: receiver name) ifNotNil: [:type| | derefType | type last = $* ifFalse: [^receiver structTargetKindIn: aCodeGen]. (VMStructType isTypeStruct: (aCodeGen extractTypeFor: receiver name fromDeclaration: type allButLast)) ifTrue: [^#struct]]]. + (receiver structTargetKindIn: aCodeGen) ifNotNilDo: - (receiver structTargetKindIn: aCodeGen) ifNotNil: [:kind| ^kind]]. (aCodeGen selectorReturnsPointerToStruct: selector) ifTrue: [^#pointer]. (aCodeGen selectorReturnsStruct: selector) ifTrue: [^#struct]. ^nil! Item was changed: ----- Method: VMMaker class>>forceNewFileNamed: (in category 'utilities') ----- + forceNewFileNamed: fileName + "Use CrLfFileStream for older images such as Squeak 3.6, or MultiByteFileStream + if CrLfFileStream is no longer present. LrLfFileStream is first choice because + forceNewFileNamed: was a late addition to MultiByteFileStream." - forceNewFileNamed: aFilename - "Always output files in unix lf format. - A single format is friendlier to e.g. external version control systems. - The Microsoft and old MacOS classic C compilers all accept lf format files." + (Smalltalk classNamed: 'CrLfFileStream') + ifNotNilDo: [ :crlf | ^ crlf forceNewFileNamed: fileName ]. + (Smalltalk classNamed: 'MultiByteFileStream') + ifNotNilDo: [ :cls | ^ ((cls forceNewFileNamed: fileName) lineEndConvention: #lf; yourself) ]. + ! - ^(MultiByteFileStream forceNewFileNamed: aFilename) - lineEndConvention: #lf; - yourself! Item was changed: ----- Method: VMMakerTool>>entryRowWithLabel:labelWidth:balloonText:getFieldText:setFieldText:buttonLabel:buttonAction:buttonBalloonText: (in category 'window construction') ----- entryRowWithLabel: label labelWidth: lWidth balloonText: balloonText getFieldText: getTextSelector setFieldText: setTextSelector buttonLabel: buttonLabel buttonAction: buttonAction buttonBalloonText: buttonBalloonText | row tm | row := Morph new color: Color transparent; hResizing: #spaceFill; vResizing: #spaceFill; extent: 550 @ 40; layoutPolicy: ProportionalLayout new; borderWidth: 2; setBalloonText: balloonText translated; yourself. row addMorph: (TextMorph new contents: label translated asText allBold) lock fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 0 @ 1) offsets: (3 @ 3 corner: lWidth @ -3)). row addMorph: ((tm := PluggableTextMorph on: self text: getTextSelector + accept: setTextSelector) acceptOnCR: true) - accept: setTextSelector) hideVScrollBarIndefinitely: true; - acceptOnCR: true) fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (lWidth + 10 @ 0 corner: (lWidth / 1.8 + 10) negated @ 0)). "Make the background a solid color so that eventual bleed from the labels doesn't make the entire input field unreadable. Happens when the bold font is significantly wider than the non-bold font or when the spacing of the font doesn't match the guess above" tm color: (Color gray: 0.9). buttonAction ifNotNil: [row addMorph: (SimpleButtonMorph new target: self; label: buttonLabel translated; actionSelector: buttonAction; hResizing: #spaceFill; setBalloonText: buttonBalloonText translated) fullFrame: (LayoutFrame fractions: (1 @ 0 corner: 1 @ 1) offsets: ((lWidth / 1.8 + 5) negated @ 3 corner: -5 @ -3))]. ^ row! Item was changed: ----- Method: VMStructType class>>checkGenerateFieldAccessors:bitPosition:in: (in category 'code generation') ----- checkGenerateFieldAccessors: fieldSpecs bitPosition: firstBitPosition in: surrogateClass | bitPosition alignedByteSize | bitPosition := firstBitPosition. fieldSpecs do: [:spec| | code | "If the accessor is already defined in a superclass don't redefine it in the subclass. We assume it is correctly defined in the superclass." (spec first ~= #unused and: [(surrogateClass whichClassIncludesSelector: spec first asSymbol) ifNil: [true] + ifNotNilDo: [:implementingClass| - ifNotNil: [:implementingClass| self assert: (implementingClass inheritsFrom: Object). implementingClass == surrogateClass]]) ifTrue: [code := self getter: spec first bitPosition: bitPosition bitWidth: spec second bool: (spec at: 3 ifAbsent: []) = #Boolean. code ~= (surrogateClass sourceCodeAt: spec first asSymbol ifAbsent: ['']) asString ifTrue: [surrogateClass compile: code classified: #accessing]. code := self setter: spec first bitPosition: bitPosition bitWidth: spec second bool: (spec at: 3 ifAbsent: []) = #Boolean. code ~= (surrogateClass sourceCodeAt: (spec first, ':') asSymbol ifAbsent: ['']) asString ifTrue: [surrogateClass compile: code classified: #accessing]]. bitPosition := bitPosition + spec second]. alignedByteSize := bitPosition / 8. self assert: alignedByteSize isInteger. alignedByteSize ~= surrogateClass alignedByteSize ifTrue: [surrogateClass class compile: 'alignedByteSize' , (String with: Character cr with: Character tab with: $^) , alignedByteSize printString classified: #accessing]! Item was changed: ----- Method: VMStructType class>>needsTypeTag (in category 'translation') ----- needsTypeTag self instVarNamesAndTypesForTranslationDo: [:ivn :type| + (self string: (type isArray ifTrue: [type first] ifFalse: [type]) includesSubstring: self structTagName) ifTrue: - ((type isArray ifTrue: [type first] ifFalse: [type]) includesSubString: self structTagName) ifTrue: [^true]]. ^false!

1 0

← Newer
1
2
3
4
5
6
7
8
...
16
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 November 2020