diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index 3cc112e19d..01c3ef0724 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -601,6 +601,7 @@ CoInterpreter >> addNewMethodToCache: classObj [ { #category : 'image save/restore' } CoInterpreter >> allocateMemoryForImage: f withHeader: header [ + @@ -615,12 +616,18 @@ CoInterpreter >> allocateMemoryForImage: f withHeader: header [ cogCodeSize := cogCodeSize min: cogit maxCogCodeSize. objectMemory getMemoryMap initialCodeZoneSize: cogCodeSize. + objectMemory getMemoryMap initialCodeOnlyZoneSize: cogCodeSize. "SH: code only zone" super allocateMemoryForImage: f withHeader: header. self beforeCodeZoneInitialization. cogit initializeCodeZoneFrom: objectMemory getMemoryMap codeZoneStart - upTo: objectMemory getMemoryMap codeZoneEnd + upTo: objectMemory getMemoryMap codeZoneEnd. + + "SH: code only zone" + cogit + initializeCodeOnlyZoneFrom: objectMemory getMemoryMap codeOnlyZoneStart + upTo: objectMemory getMemoryMap codeOnlyZoneEnd. ] { #category : 'trampoline support' } @@ -789,20 +796,19 @@ CoInterpreter >> attemptToSwitchToMachineCode: bcpc [ (self methodHasCogMethod: method) + ifTrue:[cogMethod := self cogMethodOf: method. + pc := self convertToMachineCodeFrame: cogMethod bcpc: bcpc. + self assertValidMachineCodeFrame: pc. + self push: pc. + self push: objectMemory nilObject. + self callEnilopmart: #ceEnterCogCodePopReceiverReg] ifFalse: [ (self iframeIsBlockActivation: framePointer) ifTrue: [ "Compiled block / full closure" cls := self frameStackedReceiver: framePointer numArgs: (self frameNumArgs: framePointer). cogit cogFullBlockMethod: method numCopied: (objectMemory numPointerSlotsOf: cls) - FullClosureFirstCopiedValueIndex] ifFalse: [ "Compiled method" - cogit cog: method selector: objectMemory nilObject ] ]. - (self methodHasCogMethod: method) ifTrue: - [cogMethod := self cogMethodOf: method. - pc := self convertToMachineCodeFrame: cogMethod bcpc: bcpc. - self assertValidMachineCodeFrame: pc. - self push: pc. - self push: objectMemory nilObject. - self callEnilopmart: #ceEnterCogCodePopReceiverReg] + cogit cog: method selector: objectMemory nilObject ] ] ] { #category : 'return bytecodes' } diff --git a/smalltalksrc/VMMaker/CoInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/CoInterpreterPrimitives.class.st index 4821c95f3f..a0d7b1e679 100644 --- a/smalltalksrc/VMMaker/CoInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/CoInterpreterPrimitives.class.st @@ -151,109 +151,6 @@ CoInterpreterPrimitives >> primitiveFunctionPointerAddress [ inSmalltalk: [cogit simulatedReadWriteVariableAddress: #primitiveFunctionPointer in: self] ] -{ #category : 'system control primitives' } -CoInterpreterPrimitives >> primitiveGetVMParameter: index [ - "See primitiveVMParameter method comment. - Return an OOP if success. - Return nil if no argument is available for the index" - index caseOf: { - [1] -> [^self positiveMachineIntegerFor: objectMemory oldSpaceSize]. - [2] -> [^objectMemory integerObjectOf: objectMemory newSpaceSize]. - [3] -> [^self positiveMachineIntegerFor: objectMemory totalMemorySize]. - [6] -> [^objectMemory integerObjectOf: objectMemory tenuringThreshold]. - [7] -> [^objectMemory integerObjectOf: objectMemory statFullGCs]. - [8] -> [^objectMemory integerObjectOf: objectMemory statFullGCUsecs + 500 // 1000]. - [9] -> [^objectMemory integerObjectOf: objectMemory statScavenges]. - [10] -> [^objectMemory integerObjectOf: objectMemory statScavengeGCUsecs + 500 // 1000]. - [11] -> [^objectMemory integerObjectOf: objectMemory statTenures]. - [12] -> [^ConstZero]. "Was JITTER VM info" - [13] -> [^ConstZero]. "Was JITTER VM info" - [14] -> [^ConstZero]. "Was JITTER VM info" - [15] -> [^ConstZero]. "Was JITTER VM info" - [16] -> [^self positive64BitIntegerFor: statIdleUsecs]. - [17] -> [^(SistaVM and: [self isCog]) - ifTrue: [objectMemory floatObjectOf: self getCogCodeZoneThreshold] - ifFalse: [ConstZero]]. - [18] -> [^objectMemory integerObjectOf: objectMemory statCompactionUsecs + 500 // 1000]. - [19] -> [^objectMemory integerObjectOf: objectMemory scavengeThresholdAsExtent]. - [20] -> [^objectMemory positive64BitIntegerFor: self ioUTCStartMicroseconds]. - [21] -> [^objectMemory integerObjectOf: objectMemory rootTableCount]. - [22] -> [^objectMemory integerObjectOf: objectMemory statRootTableOverflows]. - [23] -> [^objectMemory integerObjectOf: extraVMMemory]. - [24] -> [^objectMemory integerObjectOf: objectMemory shrinkThreshold]. - [25] -> [^objectMemory integerObjectOf: objectMemory growHeadroom]. - [26] -> [^objectMemory integerObjectOf: self ioHeartbeatMilliseconds]. - [27] -> [^objectMemory integerObjectOf: objectMemory statMarkCount]. - [28] -> [^objectMemory integerObjectOf: objectMemory statSweepCount]. - [29] -> [^objectMemory integerObjectOf: objectMemory statMkFwdCount]. - [30] -> [^objectMemory integerObjectOf: objectMemory statCompMoveCount]. - [31] -> [^objectMemory integerObjectOf: objectMemory statGrowMemory]. - [32] -> [^objectMemory integerObjectOf: objectMemory statShrinkMemory]. - [33] -> [^objectMemory integerObjectOf: objectMemory statRootTableCount]. - [34] -> [^objectMemory positive64BitIntegerFor: objectMemory currentAllocatedBytes]. - [35] -> [^objectMemory integerObjectOf: objectMemory statSurvivorCount]. - [36] -> [^objectMemory integerObjectOf: (self microsecondsToMilliseconds: objectMemory statGCEndUsecs)]. - [37] -> [^objectMemory integerObjectOf: objectMemory statSpecialMarkCount]. - [38] -> [^objectMemory integerObjectOf: objectMemory statIGCDeltaUsecs + 500 // 1000]. - [39] -> [^ConstZero]. "free" - [40] -> [^objectMemory integerObjectOf: objectMemory wordSize]. - [41] -> [^objectMemory integerObjectOf: self imageFormatVersion]. - [42] -> [^objectMemory integerObjectOf: numStackPages]. - [43] -> [^objectMemory integerObjectOf: desiredNumStackPages]. - [44] -> [^objectMemory integerObjectOf: objectMemory edenBytes]. - [45] -> [^objectMemory integerObjectOf: desiredEdenBytes]. - [46] -> [^self getCogCodeSize]. - [47] -> [^self getDesiredCogCodeSize]. - [48] -> [^self getCogVMFlags]. - [49] -> [^objectMemory integerObjectOf: self ioGetMaxExtSemTableSize]. - [52] -> [^objectMemory integerObjectOf: objectMemory rootTableCapacity]. - [53] -> [^objectMemory integerObjectOf: objectMemory numSegments]. - [54] -> [^objectMemory integerObjectOf: objectMemory freeSize]. - [55] -> [^objectMemory floatObjectOf: objectMemory getHeapGrowthToSizeGCRatio]. - [56] -> [^self positive64BitIntegerFor: statProcessSwitch]. - [57] -> [^ConstZero "free"]. - [58] -> [^self positive64BitIntegerFor: statForceInterruptCheck]. - [59] -> [^self positive64BitIntegerFor: statCheckForEvents]. - [60] -> [^self positive64BitIntegerFor: statStackOverflow]. - [61] -> [^self positive64BitIntegerFor: statStackPageDivorce]. - [62] -> [^self getCodeCompactionCount]. - [63] -> [^self getCodeCompactionMSecs]. - [64] -> [^self getCogMethodCount]. - [65] -> [^self getCogVMFeatureFlags]. - [66] -> [^objectMemory integerObjectOf: self stackPageByteSize]. - [67] -> [^objectMemory integerObjectOf: objectMemory maxOldSpaceSize]. - [68] -> [^objectMemory floatObjectOf: stackPages statAverageLivePagesWhenMapping]. - [69] -> [^objectMemory integerObjectOf: stackPages statMaxPageCountWhenMapping]. - [70] -> [^objectMemory integerObjectOf: (self cCode: 'VM_PROXY_MAJOR' inSmalltalk: [self class vmProxyMajorVersion])]. - [71] -> [^objectMemory integerObjectOf: (self cCode: 'VM_PROXY_MINOR' inSmalltalk: [self class vmProxyMinorVersion])]. - [72] -> [^objectMemory integerObjectOf: objectMemory statMarkUsecs + 500 // 1000]. - [73] -> [^objectMemory integerObjectOf: objectMemory statSweepUsecs + 500 // 1000]. - [74] -> [^objectMemory integerObjectOf: objectMemory statMaxAllocSegmentTime + 500 // 1000]. - [75] -> [^self getMethodCompilationCount]. - [76] -> [^self getMethodCompilationMSecs]. - [77] -> [^self getBlockCompilationCount]. - [78] -> [^self getBlockCompilationMSecs]. - [79] -> [^objectMemory integerObjectOf: self getImageVersion ]. - [80] -> [^objectMemory integerObjectOf: - objectMemory getFromOldSpaceRememberedSet rememberedSetSize]. - [81] -> [^objectMemory integerObjectOf: - objectMemory getFromOldSpaceRememberedSet rememberedSetLimit]. - [82] -> [^objectMemory integerObjectOf: - objectMemory getFromPermToOldSpaceRememberedSet rememberedSetSize]. - [83] -> [^objectMemory integerObjectOf: - objectMemory getFromPermToOldSpaceRememberedSet rememberedSetLimit]. - [84] -> [^objectMemory integerObjectOf: - objectMemory getFromPermToNewSpaceRememberedSet rememberedSetSize]. - [85] -> [^objectMemory integerObjectOf: - objectMemory getFromPermToNewSpaceRememberedSet rememberedSetLimit]. - [86] -> [^objectMemory getAvoidSearchingSegmentsWithPinnedObjects ifTrue: [ objectMemory trueObject ] ifFalse: [objectMemory falseObject]]. - [87] -> [^objectMemory integerObjectOf: cogit getStatTotalHeaderSize ]. - [88] -> [^objectMemory integerObjectOf: cogit getStatTotalCodeSize ]. - [89] -> [^objectMemory integerObjectOf: cogit getStatTotalMapSize ]. - } - otherwise: [^nil] -] - { #category : 'process primitives' } CoInterpreterPrimitives >> primitiveLongRunningPrimitiveSemaphore [ "Primitive. Install the semaphore to be used for collecting long-running primitives, diff --git a/smalltalksrc/VMMaker/CogMethod.class.st b/smalltalksrc/VMMaker/CogMethod.class.st index 1160c0fc6d..ec53541eb2 100644 --- a/smalltalksrc/VMMaker/CogMethod.class.st +++ b/smalltalksrc/VMMaker/CogMethod.class.st @@ -46,7 +46,8 @@ Class { 'picUsage', 'methodObject', 'methodHeader', - 'selector' + 'selector', + 'codeSize' ], #pools : [ 'CogMethodConstants', @@ -260,6 +261,14 @@ CogMethod >> cmUsesPenultimateLit: anObject [ ^cmUsesPenultimateLit := anObject ] +{ #category : 'accessing' } +CogMethod >> codeSize: anInteger [ + + "Set the value of the size of the code only zone" + + ^codeSize := anInteger +] + { #category : 'testing' } CogMethod >> containsAddress: anAddress [ "is anAddress within my bounds; not a test of addresses referred to within instructions in the method" diff --git a/smalltalksrc/VMMaker/CogMethodSurrogate.class.st b/smalltalksrc/VMMaker/CogMethodSurrogate.class.st index 95ea4c19e9..74dd9d118b 100644 --- a/smalltalksrc/VMMaker/CogMethodSurrogate.class.st +++ b/smalltalksrc/VMMaker/CogMethodSurrogate.class.st @@ -5,7 +5,8 @@ Class { 'address', 'memory', 'baseHeaderSize', - 'cogit' + 'cogit', + 'codeSize' ], #pools : [ 'CogMethodConstants', @@ -137,6 +138,14 @@ CogMethodSurrogate >> cmIsFullBlock [ ^ self cpicHasMNUCaseOrCMIsFullBlock ] +{ #category : 'accessing' } +CogMethodSurrogate >> codeSize: anInteger [ + + "Set the value of the size of the code only zone" + + ^codeSize := anInteger +] + { #category : 'testing' } CogMethodSurrogate >> containsAddress: anAddress [ ^address <= anAddress asUnsignedInteger diff --git a/smalltalksrc/VMMaker/CogMethodZone.class.st b/smalltalksrc/VMMaker/CogMethodZone.class.st index f184f2b87d..65ce4f1df7 100644 --- a/smalltalksrc/VMMaker/CogMethodZone.class.st +++ b/smalltalksrc/VMMaker/CogMethodZone.class.st @@ -69,7 +69,8 @@ Class { 'objectRepresentation', 'cogit', 'objectMemory', - 'percentageToEnsureRelease' + 'percentageToEnsureRelease', + 'cozFreeStart' ], #pools : [ 'CogMethodConstants', @@ -299,6 +300,20 @@ CogMethodZone >> compactionInProgress [ ^compactionInProgress ] +{ #category : 'accessing' } +CogMethodZone >> cozFreeStart [ + + "Next available address of the code only zone" + ^cozFreeStart +] + +{ #category : 'accessing' } +CogMethodZone >> cozFreeStart: anInteger [ + + "Next available address of the code only zone" + cozFreeStart := anInteger. +] + { #category : 'allocating' } CogMethodZone >> effectiveLimit [ @@ -620,7 +635,8 @@ CogMethodZone >> printCogMethods [ coInterpreter print: 'CMMethod '; printNum: nm; print: ' CMClosedPIC '; printNum: nc; print: ' CMOpenPIC '; printNum: no; print: ' CMFree '; printNum: nf. nu > 0 ifTrue: [coInterpreter print: ' UNKNOWN '; printNum: nu]. - coInterpreter print: ' total '; printNum: nm+nc+no+nf+nu; cr + coInterpreter print: ' total '; printNum: nm+nc+no+nf+nu; cr. + coInterpreter print: 'Total code size '; printNum: cogit getStatTotalCodeSize; print: ' Total map size '; printNum: cogit getStatTotalMapSize; print: ' Total header size '; printNum: cogit getStatTotalHeaderSize; cr ] { #category : 'printing' } diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index 197c524d94..eed3086e57 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -255,7 +255,8 @@ Class { 'statTotalCodeSize', 'statTotalHeaderSize', 'statTotalMapSize', - 'jitCodeZoneWriteEnabled' + 'jitCodeZoneWriteEnabled', + 'jitEnabled' ], #classVars : [ 'AnnotationConstantNames', @@ -506,6 +507,8 @@ Cogit class >> declareCVarsIn: aCCodeGenerator [ aCCodeGenerator var: #jitCodeZoneWriteEnabled declareC: 'int jitCodeZoneWriteEnabled = 0'; + var: #jitEnabled + declareC: 'int jitEnabled = 1'; var: #ordinarySendTrampolines declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]'; var: #superSendTrampolines @@ -4441,10 +4444,11 @@ Cogit >> cog: aMethodObj selector: aSelectorOop [ + | selector cogMethod startTime | - (self exclude: aMethodObj selector: aSelectorOop) ifTrue: + ((self exclude: aMethodObj selector: aSelectorOop) or: jitEnabled not) ifTrue: [^nil]. startTime := coInterpreter ioUTCMicrosecondsNow. @@ -4462,8 +4466,10 @@ Cogit >> cog: aMethodObj selector: aSelectorOop [ receiverTags := objectMemory receiverTagBitsForMethod: methodObj. cogMethod := self compileCogMethod: aSelectorOop. (cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue: - [cogMethod asInteger = InsufficientCodeSpace ifTrue: - [coInterpreter callForCogCompiledCodeCompaction]. + [(cogMethod asInteger = InsufficientCodeSpace) ifTrue: + [self disableJitForDebug + "SH: line above should be removed later" + "coInterpreter callForCogCompiledCodeCompaction"]. ^nil]. statCompileMethodCount := statCompileMethodCount + 1. @@ -5267,21 +5273,6 @@ Cogit >> compileCogMethod: selector [ ^self generateCogMethod: selector ] -{ #category : 'compile abstract instructions' } -Cogit >> compileEntireFullBlockMethod: numCopied [ - "Compile the abstract instructions for the entire full block method." - | result | - self preenMethodLabel. - self compileFullBlockEntry. - - "Frame build" - self compileFullBlockMethodFrameBuild: numCopied. - "Method body" - (result := self compileMethodBody) < 0 ifTrue: - [^result]. - ^0 -] - { #category : 'compile abstract instructions' } Cogit >> compileEntireMethod [ "Compile the abstract instructions for the entire method, including blocks." @@ -5770,6 +5761,12 @@ Cogit >> disableCodeZoneWrite [ jitCodeZoneWriteEnabled := false ] +{ #category : 'cog jit support' } +Cogit >> disableJitForDebug [ + + jitEnabled := false. +] + { #category : 'simulation only' } Cogit >> doesNotUnderstand: aMessage [ (aMessage selector beginsWith: 'print') ifTrue: @@ -6167,14 +6164,16 @@ Cogit >> fillInCPICHeader: pic numArgs: numArgs numCases: numCases hasMNUCase: h ] { #category : 'generate machine code' } -Cogit >> fillInMethodHeader: method size: size selector: selector [ +Cogit >> fillInMethodHeader: method size: size codeSize: codeSize selector: selector [ | originalMethod rawHeader | + method cmType: CMMethod. method objectHeader: objectMemory nullHeaderForMachineCodeMethod. method blockSize: size. + method codeSize: codeSize. method methodObject: methodObj. rawHeader := coInterpreter rawHeaderOf: methodObj. "If the method has already been cogged then @@ -7519,6 +7518,7 @@ Cogit >> generateCogFullBlock [ It could be of the same size, but maybe the cmType could be different and the selector could be ignored." method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *') size: totalSize + codeSize: codeSize selector: objectMemory nilObject. method cpicHasMNUCaseOrCMIsFullBlock: true. postCompileHook ifNotNil: @@ -7537,8 +7537,9 @@ Cogit >> generateCogMethod: selector [ that fixes up jumps. When fixing up a jump the jump is not allowed to choose a smaller offset but must stick to the size set in the second pass." - | codeSize headerSize mapSize totalSize startAddress result method | + | codeSize headerSize mapSize totalSize startAddress result method codeStartAddress codeResult | + headerSize := self sizeof: CogMethod. methodLabel address: methodZone freeStart. @@ -7548,9 +7549,10 @@ Cogit >> generateCogMethod: selector [ self enableCodeZoneWriteDuring: [ codeSize := self generateInstructionsAt: methodLabel address + headerSize. mapSize := self generateMapAt: nil start: methodLabel address + cmNoCheckEntryOffset]. - statTotalCodeSize := statTotalCodeSize + codeSize. - statTotalMapSize := statTotalMapSize + mapSize. - statTotalHeaderSize := statTotalHeaderSize + headerSize. + + statTotalCodeSize := statTotalCodeSize + codeSize. + statTotalMapSize := statTotalMapSize + mapSize. + statTotalHeaderSize := statTotalHeaderSize + headerSize. totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize. totalSize > MaxMethodSize ifTrue: @@ -7569,10 +7571,18 @@ Cogit >> generateCogMethod: selector [ self generateMapAt: startAddress + totalSize - 1 start: startAddress + cmNoCheckEntryOffset. method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *') size: totalSize + codeSize: codeSize selector: selector. postCompileHook ifNotNil: [self perform: postCompileHook with: method. - postCompileHook := nil]] + postCompileHook := nil]. + "SH: codeOnlyZone" + codeStartAddress := methodZone cozFreeStart. + codeResult := self outputInstructionsAt: codeStartAddress. + self assert: codeStartAddress + codeSize = codeResult. + backEnd padIfPossibleWithStopsFrom: codeResult to: codeStartAddress + codeSize - 1. + methodZone cozFreeStart: codeStartAddress + codeSize. + ] flushingCacheWith: [self flushICacheFrom: method asUnsignedInteger to: method asUnsignedInteger + totalSize]. ^method @@ -8338,6 +8348,7 @@ Cogit >> initialize [ statTotalCodeSize := 0. statTotalMapSize := 0. jitCodeZoneWriteEnabled := false. + jitEnabled := true. ] { #category : 'initialization' } @@ -8351,6 +8362,21 @@ Cogit >> initializeBackend [ literalsManager allocateLiterals: 4; resetLiterals ] +{ #category : 'initialization' } +Cogit >> initializeCodeOnlyZoneFrom: startAddress upTo: endAddress [ + + + self enableCodeZoneWriteDuring: [ + backEnd stopsFrom: startAddress to: endAddress - 1 ]. + + self + simulationOnly: [ + startAddress = self class guardPageSize ifTrue: [ + backEnd stopsFrom: 0 to: endAddress - 1 ]. + "self initializeProcessor" ]. + methodZone cozFreeStart: startAddress. +] + { #category : 'initialization' } Cogit >> initializeCodeZoneFrom: startAddress upTo: endAddress [ @@ -8366,6 +8392,7 @@ Cogit >> initializeCodeZoneFrom: startAddress upTo: endAddress [ backEnd stopsFrom: 0 to: endAddress - 1 ]. self initializeProcessor ]. codeBase := methodZoneBase := startAddress. + minValidCallAddress := (codeBase min: coInterpreter interpretAddress) min: coInterpreter primitiveFailAddress. methodZone manageFrom: methodZoneBase to: endAddress. diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index 06bdcd0de8..724ccfdc29 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -1916,6 +1916,7 @@ SpurMemoryManager >> allocateMemoryOfSize: memoryBytes initialAddress: initialAd { #category : 'initialization' } SpurMemoryManager >> allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes methodCacheSize: methodCacheSize primitiveTraceLogSize: primitiveLogSize rumpCStackSize: rumpCStackSize permSpaceSize: permSpaceSize [ + "Intialize the receiver for bootsraping an image. Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold @@ -1940,6 +1941,7 @@ SpurMemoryManager >> allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceByt initialNewSpaceSize: newSpaceBytes; initialHeadroom: 0; initialCodeZoneSize: codeBytes; + initialCodeOnlyZoneSize: codeBytes; "SH: codeOnlyZone" initialPermSpaceSize: permSpaceSize; allocateHeap. diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index e7270ae2d4..23c564f7e7 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -1453,6 +1453,106 @@ StackInterpreterPrimitives >> primitiveGetCurrentWorkingDirectory [ self pop: argumentCount+1 thenPush: (objectMemory stringForCString: aCString). ] +{ #category : 'system control primitives' } +StackInterpreterPrimitives >> primitiveGetVMParameter: index [ + "See primitiveVMParameter method comment. + Return an OOP if success. + Return nil if no argument is available for the index" + index caseOf: { + [1] -> [^self positiveMachineIntegerFor: objectMemory oldSpaceSize]. + [2] -> [^objectMemory integerObjectOf: objectMemory newSpaceSize]. + [3] -> [^self positiveMachineIntegerFor: objectMemory totalMemorySize]. + [6] -> [^objectMemory integerObjectOf: objectMemory tenuringThreshold]. + [7] -> [^objectMemory integerObjectOf: objectMemory statFullGCs]. + [8] -> [^objectMemory integerObjectOf: objectMemory statFullGCUsecs + 500 // 1000]. + [9] -> [^objectMemory integerObjectOf: objectMemory statScavenges]. + [10] -> [^objectMemory integerObjectOf: objectMemory statScavengeGCUsecs + 500 // 1000]. + [11] -> [^objectMemory integerObjectOf: objectMemory statTenures]. + [12] -> [^ConstZero]. "Was JITTER VM info" + [13] -> [^ConstZero]. "Was JITTER VM info" + [14] -> [^ConstZero]. "Was JITTER VM info" + [15] -> [^ConstZero]. "Was JITTER VM info" + [16] -> [^self positive64BitIntegerFor: statIdleUsecs]. + [17] -> [^(SistaVM and: [self isCog]) + ifTrue: [objectMemory floatObjectOf: self getCogCodeZoneThreshold] + ifFalse: [ConstZero]]. + [18] -> [^objectMemory integerObjectOf: objectMemory statCompactionUsecs + 500 // 1000]. + [19] -> [^objectMemory integerObjectOf: objectMemory scavengeThresholdAsExtent]. + [20] -> [^objectMemory positive64BitIntegerFor: self ioUTCStartMicroseconds]. + [21] -> [^objectMemory integerObjectOf: objectMemory rootTableCount]. + [22] -> [^objectMemory integerObjectOf: objectMemory statRootTableOverflows]. + [23] -> [^objectMemory integerObjectOf: extraVMMemory]. + [24] -> [^objectMemory integerObjectOf: objectMemory shrinkThreshold]. + [25] -> [^objectMemory integerObjectOf: objectMemory growHeadroom]. + [26] -> [^objectMemory integerObjectOf: self ioHeartbeatMilliseconds]. + [27] -> [^objectMemory integerObjectOf: objectMemory statMarkCount]. + [28] -> [^objectMemory integerObjectOf: objectMemory statSweepCount]. + [29] -> [^objectMemory integerObjectOf: objectMemory statMkFwdCount]. + [30] -> [^objectMemory integerObjectOf: objectMemory statCompMoveCount]. + [31] -> [^objectMemory integerObjectOf: objectMemory statGrowMemory]. + [32] -> [^objectMemory integerObjectOf: objectMemory statShrinkMemory]. + [33] -> [^objectMemory integerObjectOf: objectMemory statRootTableCount]. + [34] -> [^objectMemory positive64BitIntegerFor: objectMemory currentAllocatedBytes]. + [35] -> [^objectMemory integerObjectOf: objectMemory statSurvivorCount]. + [36] -> [^objectMemory integerObjectOf: (self microsecondsToMilliseconds: objectMemory statGCEndUsecs)]. + [37] -> [^objectMemory integerObjectOf: objectMemory statSpecialMarkCount]. + [38] -> [^objectMemory integerObjectOf: objectMemory statIGCDeltaUsecs + 500 // 1000]. + [39] -> [^ConstZero]. "free" + [40] -> [^objectMemory integerObjectOf: objectMemory wordSize]. + [41] -> [^objectMemory integerObjectOf: self imageFormatVersion]. + [42] -> [^objectMemory integerObjectOf: numStackPages]. + [43] -> [^objectMemory integerObjectOf: desiredNumStackPages]. + [44] -> [^objectMemory integerObjectOf: objectMemory edenBytes]. + [45] -> [^objectMemory integerObjectOf: desiredEdenBytes]. + [46] -> [^self getCogCodeSize]. + [47] -> [^self getDesiredCogCodeSize]. + [48] -> [^self getCogVMFlags]. + [49] -> [^objectMemory integerObjectOf: self ioGetMaxExtSemTableSize]. + [52] -> [^objectMemory integerObjectOf: objectMemory rootTableCapacity]. + [53] -> [^objectMemory integerObjectOf: objectMemory numSegments]. + [54] -> [^objectMemory integerObjectOf: objectMemory freeSize]. + [55] -> [^objectMemory floatObjectOf: objectMemory getHeapGrowthToSizeGCRatio]. + [56] -> [^self positive64BitIntegerFor: statProcessSwitch]. + [57] -> [^ConstZero "free"]. + [58] -> [^self positive64BitIntegerFor: statForceInterruptCheck]. + [59] -> [^self positive64BitIntegerFor: statCheckForEvents]. + [60] -> [^self positive64BitIntegerFor: statStackOverflow]. + [61] -> [^self positive64BitIntegerFor: statStackPageDivorce]. + [62] -> [^self getCodeCompactionCount]. + [63] -> [^self getCodeCompactionMSecs]. + [64] -> [^self getCogMethodCount]. + [65] -> [^self getCogVMFeatureFlags]. + [66] -> [^objectMemory integerObjectOf: self stackPageByteSize]. + [67] -> [^objectMemory integerObjectOf: objectMemory maxOldSpaceSize]. + [68] -> [^objectMemory floatObjectOf: stackPages statAverageLivePagesWhenMapping]. + [69] -> [^objectMemory integerObjectOf: stackPages statMaxPageCountWhenMapping]. + [70] -> [^objectMemory integerObjectOf: (self cCode: 'VM_PROXY_MAJOR' inSmalltalk: [self class vmProxyMajorVersion])]. + [71] -> [^objectMemory integerObjectOf: (self cCode: 'VM_PROXY_MINOR' inSmalltalk: [self class vmProxyMinorVersion])]. + [72] -> [^objectMemory integerObjectOf: objectMemory statMarkUsecs + 500 // 1000]. + [73] -> [^objectMemory integerObjectOf: objectMemory statSweepUsecs + 500 // 1000]. + [74] -> [^objectMemory integerObjectOf: objectMemory statMaxAllocSegmentTime + 500 // 1000]. + [75] -> [^self getMethodCompilationCount]. + [76] -> [^self getMethodCompilationMSecs]. + [77] -> [^self getBlockCompilationCount]. + [78] -> [^self getBlockCompilationMSecs]. + [79] -> [^objectMemory integerObjectOf: self getImageVersion ]. + [80] -> [^objectMemory integerObjectOf: + objectMemory getFromOldSpaceRememberedSet rememberedSetSize]. + [81] -> [^objectMemory integerObjectOf: + objectMemory getFromOldSpaceRememberedSet rememberedSetLimit]. + [82] -> [^objectMemory integerObjectOf: + objectMemory getFromPermToOldSpaceRememberedSet rememberedSetSize]. + [83] -> [^objectMemory integerObjectOf: + objectMemory getFromPermToOldSpaceRememberedSet rememberedSetLimit]. + [84] -> [^objectMemory integerObjectOf: + objectMemory getFromPermToNewSpaceRememberedSet rememberedSetSize]. + [85] -> [^objectMemory integerObjectOf: + objectMemory getFromPermToNewSpaceRememberedSet rememberedSetLimit]. + [86] -> [^objectMemory getAvoidSearchingSegmentsWithPinnedObjects ifTrue: [ objectMemory trueObject ] ifFalse: [objectMemory falseObject]]. + } + otherwise: [^nil] +] + { #category : 'memory space primitives' } StackInterpreterPrimitives >> primitiveIncrementalGC [ "Do a quick, incremental garbage collection and return the number of bytes immediately available. @@ -3754,7 +3854,7 @@ StackInterpreterPrimitives >> primitiveVMParameter [ Otherwise the *real* list is in the code: `StackInterpreterPrimitives>>#primitiveGetVMParameter:`" | paramsArraySize index | - paramsArraySize := 89. + paramsArraySize := 86. argumentCount = 0 ifTrue: [^self primitiveAllVMParameters: paramsArraySize]. argumentCount > 2 ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs]. diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index e188ade148..c1e96b396c 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -971,6 +971,21 @@ StackToRegisterMappingCogit >> compileCogMethod: selector [ ^super compileCogMethod: selector ] +{ #category : 'compile abstract instructions' } +StackToRegisterMappingCogit >> compileEntireFullBlockMethod: numCopied [ + "Compile the abstract instructions for the entire full block method." + | result | + self preenMethodLabel. + self compileFullBlockEntry. + + "Frame build" + self compileFullBlockMethodFrameBuild: numCopied. + "Method body" + (result := self compileMethodBody) < 0 ifTrue: + [^result]. + ^0 +] + { #category : 'compile abstract instructions' } StackToRegisterMappingCogit >> compileEntireMethod [ "Compile the abstract instructions for the entire method, including blocks." diff --git a/smalltalksrc/VMMaker/VMMemoryMap.class.st b/smalltalksrc/VMMaker/VMMemoryMap.class.st index c9414754d9..5a24763ae6 100644 --- a/smalltalksrc/VMMaker/VMMemoryMap.class.st +++ b/smalltalksrc/VMMaker/VMMemoryMap.class.st @@ -25,7 +25,10 @@ Class { 'objectMemory', 'spaceMaskToUse', 'permSpaceMask', - 'newSpaceMask' + 'newSpaceMask', + 'initialCodeOnlyZoneSize', + 'codeOnlyZoneStart', + 'codeOnlyZoneEnd' ], #pools : [ 'VMBasicConstants' @@ -78,6 +81,24 @@ VMMemoryMap class >> shouldBeGenerated [ ^ false ] +{ #category : 'private' } +VMMemoryMap >> allocateCodeOnlyZone [ + + + initialCodeOnlyZoneSize = 0 ifTrue: [ ^ self ]. + + self codeOnlyZoneStart: (self allocateJITMemory: initialCodeOnlyZoneSize _: codeZoneEnd). + self codeOnlyZoneStart ifNil: [ self insufficientMemoryAvailableError ]. + + self codeOnlyZoneStart = codeZoneEnd + ifFalse: [ + self logError: 'Could not allocate codeOnlyZone in the expected place (%p), got %p' _: codeZoneEnd _: self codeOnlyZoneStart. + self error: 'Error allocating' ]. + + self codeOnlyZoneEnd: codeOnlyZoneStart + initialCodeOnlyZoneSize. + +] + { #category : 'private' } VMMemoryMap >> allocateCodeZone [ @@ -92,13 +113,16 @@ VMMemoryMap >> allocateCodeZone [ self error: 'Error allocating' ]. self codeZoneEnd: codeZoneStart + initialCodeZoneSize. + ] { #category : 'allocating' } VMMemoryMap >> allocateHeap [ + self allocateCodeZone. + self allocateCodeOnlyZone. self allocateNewObjectsSpace. self allocateOldObjectsSpace. self allocatePermObjectsSpace. @@ -279,6 +303,26 @@ VMMemoryMap >> calculateMaskToUse [ self permSpaceMask: (memoryMapConfiguration permSpaceInitialAddress bitAnd: self spaceMaskToUse). ] +{ #category : 'accessing' } +VMMemoryMap >> codeOnlyZoneEnd [ + ^codeOnlyZoneEnd +] + +{ #category : 'accessing' } +VMMemoryMap >> codeOnlyZoneEnd: anInteger [ + codeOnlyZoneEnd := anInteger +] + +{ #category : 'accessing' } +VMMemoryMap >> codeOnlyZoneStart [ + ^ codeOnlyZoneStart +] + +{ #category : 'accessing' } +VMMemoryMap >> codeOnlyZoneStart: anInteger [ + codeOnlyZoneStart := anInteger +] + { #category : 'accessing' } VMMemoryMap >> codeZoneEnd [ @@ -412,6 +456,20 @@ VMMemoryMap >> getpagesize [ ^ 4096 ] +{ #category : 'accessing' } +VMMemoryMap >> initialCodeOnlyZoneSize [ + + + ^ initialCodeOnlyZoneSize +] + +{ #category : 'accessing' } +VMMemoryMap >> initialCodeOnlyZoneSize: aValue [ + + + initialCodeOnlyZoneSize := aValue +] + { #category : 'accessing' } VMMemoryMap >> initialCodeZoneSize [ diff --git a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st index 6e8a59a722..cf4a4b505a 100644 --- a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st @@ -792,6 +792,7 @@ VMSimpleStackBasedCogitAbstractTest >> sentSelector: anObject [ { #category : 'running' } VMSimpleStackBasedCogitAbstractTest >> setUp [ + super setUp. cogit := self newJitCompiler. @@ -813,6 +814,7 @@ VMSimpleStackBasedCogitAbstractTest >> setUp [ cogInitialAddress := memory getMemoryMap codeZoneStart. cogit methodZone manageFrom: cogInitialAddress to: memory getMemoryMap codeZoneEnd. + cogit methodZone cozFreeStart: memory getMemoryMap codeZoneEnd. cogit methodZoneBase: cogInitialAddress. cogit minCallAddress: cogInitialAddress. cogit cogCodeBase: cogInitialAddress.