diff --git a/CHANGELOG.md b/CHANGELOG.md index cfdb91c02f..39cc10df07 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Change log +## v10.3.0 + +* New harmonize rule by @RenaudFondeur in https://github.com/pharo-project/pharo-vm/pull/817 +* Ignoring EAGAIN in epoll_wait by @tesonep in https://github.com/pharo-project/pharo-vm/pull/818 +* Extend macOS implementation of SqueakSSL plugin to support setting a certificate on the SSL session context by @Rinzwind in https://github.com/pharo-project/pharo-vm/pull/816 +* Adding macro for win32. by @tesonep in https://github.com/pharo-project/pharo-vm/pull/814 + ## v10.2.1 * Adding the missing tty.c file in the packaging. by @tesonep in https://github.com/pharo-project/pharo-vm/pull/771 diff --git a/CMakeLists.txt b/CMakeLists.txt index 47f8d26ba3..6f981c3d41 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -52,8 +52,8 @@ include(cmake/versionExtraction.cmake) extractVCSInformation(GIT_COMMIT_HASH GIT_DESCRIBE GIT_COMMIT_DATE) set(VERSION_MAJOR 10) -set(VERSION_MINOR 2) -set(VERSION_PATCH_NUMBER 1) +set(VERSION_MINOR 3) +set(VERSION_PATCH_NUMBER 0) if(BUILD_IS_RELEASE) set(VERSION_PATCH "${VERSION_PATCH_NUMBER}") diff --git a/Jenkinsfile b/Jenkinsfile index 2a2985fe2e..6f1f17031b 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -239,8 +239,8 @@ def runTests(platform, configuration, packages, withWorker, additionalParameters shell "mkdir runTests" dir("runTests"){ try{ - shell "wget -O - get.pharo.org/64/110 | bash " - shell "echo 110 > pharo.version" + shell "wget -O - get.pharo.org/64/120 | bash " + shell "echo 120 > pharo.version" if(isWindows()){ runInCygwin "cd runTests && unzip ../build/build/packages/PharoVM-*-${platform}-bin.zip -d ." diff --git a/cmake/vmmaker.cmake b/cmake/vmmaker.cmake index 654d3112ec..ca1d1cccac 100644 --- a/cmake/vmmaker.cmake +++ b/cmake/vmmaker.cmake @@ -67,33 +67,33 @@ if(GENERATE_SOURCES) if(CMAKE_SYSTEM_NAME STREQUAL "Windows") message("Defining Windows VM to download for code generation") set(VMMAKER_VM ${VMMAKER_DIR}/vm/PharoConsole.exe) - set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Windows-x86_64/PharoVM-10.0.5-2757766f-Windows-x86_64-bin.zip) - set(VM_URL_HASH SHA256=917dbbef15b870ecf5ecf449bd6be39437985c6e3f056620e9acda60ea58e09e) + set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Windows-x86_64/PharoVM-10.2.1-d417aebd-Windows-x86_64-bin.zip) + set(VM_URL_HASH SHA256=450c3934f34d02258fc85ccf28a64bfea6bccfe859067ded87d7721a067b96b1) elseif(CMAKE_SYSTEM_NAME STREQUAL "Linux" AND (${CMAKE_SYSTEM_PROCESSOR} MATCHES "aarch64")) message("Defining Linux AARCH64 VM to download for code generation") set(VMMAKER_VM ${VMMAKER_DIR}/vm/pharo) - set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Linux-aarch64/PharoVM-10.0.5-2757766-Linux-aarch64-bin.zip) + set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Linux-aarch64/PharoVM-10.2.1-d417aebd-Linux-aarch64-bin.zip) set(VM_URL_HASH SHA256=2fe44aab3715f26378796bef835fc1bd51da0baa02aad3fee03610926e80a59f) elseif(CMAKE_SYSTEM_NAME STREQUAL "Linux" AND (${CMAKE_SYSTEM_PROCESSOR} MATCHES "armv7l")) message("Defining Linux ARM 32 VM to download for code generation") set(VMMAKER_VM ${VMMAKER_DIR}/vm/pharo) - set(VM_URL https://files.pharo.org/vm/pharo-spur32-headless/Linux-armv7l/PharoVM-10.0.5-2757766-Linux-armv7l-bin.zip) + set(VM_URL https://files.pharo.org/vm/pharo-spur32-headless/Linux-armv7l/PharoVM-10.2.1-d417aebd-Linux-armv7l-bin.zip) set(VM_URL_HASH SHA256=b08fdf80c21fa81d61cf8ee71abd741fc192e4a7210f20185a48ed108dfa402f) elseif(CMAKE_SYSTEM_NAME STREQUAL "Linux") message("Defining Linux VM x86_64 to download for code generation") set(VMMAKER_VM ${VMMAKER_DIR}/vm/pharo) - set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Linux-x86_64/PharoVM-10.0.5-2757766-Linux-x86_64-bin.zip) - set(VM_URL_HASH SHA256=dde65589966e4f547eb0b1b08053504f9663bdb94d520109d053dfcce7921eab) + set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Linux-x86_64/PharoVM-10.2.1-d417aeb-Linux-x86_64-bin.zip) + set(VM_URL_HASH SHA256=51704c05fe23e01142e97d8f2145ecdab7be9a51aa324b49cd82ed7a05d88bbe) elseif(CMAKE_SYSTEM_NAME STREQUAL "Darwin" AND (${CMAKE_SYSTEM_PROCESSOR} MATCHES "arm64")) message("Defining arm64 OSX VM to download for code generation") set(VMMAKER_VM ${VMMAKER_DIR}/vm/Contents/MacOS/Pharo) - set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Darwin-arm64/PharoVM-10.1.1-32b2be55-Darwin-arm64-bin.zip) - set(VM_URL_HASH SHA256=485d98f740396fd0bc7ca74a3a71bc2a332414b4e41301d7c79ba7ae3685dbe5) + set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Darwin-arm64/PharoVM-10.2.1-d417aebd-Darwin-arm64-bin.zip) + set(VM_URL_HASH SHA256=59fb55f61abe69fabf666e875cff1a5f40b91f5edd3912e37483b251eb81e2b5) elseif(CMAKE_SYSTEM_NAME STREQUAL "Darwin") message("Defining OSX VM to download for code generation") set(VMMAKER_VM ${VMMAKER_DIR}/vm/Contents/MacOS/Pharo) - set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Darwin-x86_64/PharoVM-10.0.5-2757766f-Darwin-x86_64-bin.zip) - set(VM_URL_HASH SHA256=f0f34c9411e899005749095dbdffdbeaa405ae8864aea81e4bff56331c3959e0) + set(VM_URL https://files.pharo.org/vm/pharo-spur64-headless/Darwin-x86_64/PharoVM-10.2.1-d417aebd-Darwin-x86_64-bin.zip) + set(VM_URL_HASH SHA256=7221355e6dd440d5b943eb4d0ef430e90fc6b5797f56d7702d13891f0d9db3fb) else() message(FATAL_ERROR "VM DOWNLOAD NOT HANDLED FOR CMAKE SYSTEM: ${CMAKE_SYSTEM_NAME}") endif() @@ -120,9 +120,9 @@ if(GENERATE_SOURCES) ExternalProject_Add( vmmaker - URL https://files.pharo.org/image/110/Pharo11-SNAPSHOT.build.688.sha.cf3d3fd.arch.64bit.zip - URL_HASH SHA256=c050ddcedce70ec92c22a3244aa5ebbc655dcaffcb42ac80fbf1f6e795c7010d - BUILD_COMMAND ${VMMAKER_VM} --headless ${VMMAKER_DIR}/image/Pharo11-SNAPSHOT-64bit-cf3d3fd.image --no-default-preferences save VMMaker + URL https://files.pharo.org/image/120/Pharo12.0-SNAPSHOT.build.1519.sha.aa50f9c.arch.64bit.zip + URL_HASH SHA256=b12270631ffc0c6adcb0b6449565b9abfd8e88a863a894a7320f660c05a0af1e + BUILD_COMMAND ${VMMAKER_VM} --headless ${VMMAKER_DIR}/image/Pharo12.0-SNAPSHOT-64bit-aa50f9c.image --no-default-preferences save VMMaker COMMAND ${VMMAKER_VM} --headless ${VMMAKER_IMAGE} --no-default-preferences --save --quit "${CMAKE_CURRENT_SOURCE_DIR_TO_OUT}/scripts/installVMMaker.st" "${CMAKE_CURRENT_SOURCE_DIR_TO_OUT}" "${ICEBERG_DEFAULT_REMOTE}" UPDATE_COMMAND "" CONFIGURE_COMMAND "" diff --git a/extracted/plugins/SqueakSSL/src/osx/sqMacSSL.c b/extracted/plugins/SqueakSSL/src/osx/sqMacSSL.c index 4b61be6aea..2c28e855e9 100644 --- a/extracted/plugins/SqueakSSL/src/osx/sqMacSSL.c +++ b/extracted/plugins/SqueakSSL/src/osx/sqMacSSL.c @@ -206,6 +206,40 @@ OSStatus sqSetupSSL(sqSSL* ssl, int isServer) } } + if (ssl->certName) { + CFStringRef certName = CFStringCreateWithCString(kCFAllocatorDefault, ssl->certName, kCFStringEncodingASCII); + if (certName == NULL) + return SQSSL_GENERIC_ERROR; + CFMutableDictionaryRef query = CFDictionaryCreateMutable(kCFAllocatorDefault, 0, &kCFTypeDictionaryKeyCallBacks, &kCFTypeDictionaryValueCallBacks); + if (query == NULL) { + CFRelease(certName); + return SQSSL_GENERIC_ERROR; + } + CFDictionarySetValue(query, kSecMatchLimit, kSecMatchLimitOne); + CFDictionarySetValue(query, kSecReturnRef, kCFBooleanTrue); + CFDictionarySetValue(query, kSecClass, kSecClassIdentity); + CFDictionarySetValue(query, kSecMatchSubjectWholeString, certName); + CFDictionarySetValue(query, kSecMatchValidOnDate, kCFNull); + CFRelease(certName); + SecIdentityRef identity; + status = SecItemCopyMatching(query, (CFTypeRef*) &identity); + CFRelease(query); + if (status != noErr) { + logStatus(status, status == errSecItemNotFound ? "SecItemCopyMatching had no results" : "SecItemCopyMatching failed"); + return status; + } + CFArrayRef certs = CFArrayCreate(kCFAllocatorDefault, (const void **)&identity, 1, &kCFTypeArrayCallBacks); + CFRelease(identity); + if (certs == NULL) + return SQSSL_GENERIC_ERROR; + status = SSLSetCertificate(ssl->ctx, certs); + CFRelease(certs); + if (status != noErr) { + logStatus(status, "SSLSetCertificate failed"); + return status; + } + } + return status; } @@ -626,7 +660,7 @@ sqInt sqAcceptSSL(sqInt handle, char* srcBuf, sqInt srcLen, char* dstBuf, } /* We are connected. Verify the cert. */ ssl->state = SQSSL_CONNECTED; - return SQSSL_OK; + return ssl->outLen; } /* sqEncryptSSL: Encrypt data for SSL transmission. diff --git a/extracted/vm/src/unix/aio.c b/extracted/vm/src/unix/aio.c index 1b0b29a12e..f38989b1ec 100644 --- a/extracted/vm/src/unix/aio.c +++ b/extracted/vm/src/unix/aio.c @@ -308,7 +308,7 @@ aio_handle_events(long microSecondsTimeout){ aio_flush_pipe(signal_pipe_fd[0]); if(epollReturn == -1){ - if(errno != EINTR){ + if(errno != EINTR && errno != EAGAIN){ logErrorFromErrno("epoll_wait"); } return 0; diff --git a/ffi/src/worker/worker.c b/ffi/src/worker/worker.c index c2c420ce06..f3a53d4d14 100644 --- a/ffi/src/worker/worker.c +++ b/ffi/src/worker/worker.c @@ -120,7 +120,7 @@ void worker_release(Worker *worker) { worker_add_call((Worker*)worker, task); } -inline void worker_dispatch_callout(Worker *worker, WorkerTask *task) { +void worker_dispatch_callout(Worker *worker, WorkerTask *task) { worker_add_call(worker, task); } diff --git a/scripts/installVMMaker.st b/scripts/installVMMaker.st index 73468f1072..f875543763 100644 --- a/scripts/installVMMaker.st +++ b/scripts/installVMMaker.st @@ -1,6 +1,7 @@ Author useAuthor: 'installVMMaker' during: [ - path := CommandLineArguments default commandLineArguments nextToLast. - defaultRemoteType := CommandLineArguments default commandLineArguments last asSymbol. + | path defaultRemoteType | + path := CommandLineArguments new commandLineArguments nextToLast. + defaultRemoteType := CommandLineArguments new commandLineArguments last asSymbol. Iceberg remoteTypeSelector: defaultRemoteType. diff --git a/smalltalksrc/BaselineOfVMMaker/BaselineOfVMMaker.class.st b/smalltalksrc/BaselineOfVMMaker/BaselineOfVMMaker.class.st index 501b2c2b10..1fa6072562 100644 --- a/smalltalksrc/BaselineOfVMMaker/BaselineOfVMMaker.class.st +++ b/smalltalksrc/BaselineOfVMMaker/BaselineOfVMMaker.class.st @@ -1,7 +1,7 @@ Class { #name : #BaselineOfVMMaker, #superclass : #BaselineOf, - #category : #BaselineOfVMMaker + #category : 'BaselineOfVMMaker' } { #category : #baselines } @@ -39,7 +39,7 @@ BaselineOfVMMaker >> baseline: spec [ spec baseline: 'LLVMDisassembler' with: [ spec repository: 'github://pharo-project/pharo-llvmDisassembler' ]. spec baseline: 'OpalSimdBytecode' with: [ - spec repository: 'github://nrainhart/pharo-opal-simd-bytecode:main' ]. + spec repository: 'github://evref-inria/pharo-opal-simd-bytecode:main' ]. "Tests" spec diff --git a/smalltalksrc/Melchor/CCodeGeneratorGlobalStructure.class.st b/smalltalksrc/Melchor/CCodeGeneratorGlobalStructure.class.st index 2744aa919a..abb026ff87 100644 --- a/smalltalksrc/Melchor/CCodeGeneratorGlobalStructure.class.st +++ b/smalltalksrc/Melchor/CCodeGeneratorGlobalStructure.class.st @@ -10,7 +10,7 @@ Class { 'localStructDef', 'structDefDefine' ], - #category : #Melchor + #category : 'Melchor' } { #category : #'CAST translation' } @@ -187,46 +187,44 @@ CCodeGeneratorGlobalStructure >> emitGlobalStructFlagOn: aStream [ ] { #category : #'CAST translation' } -CCodeGeneratorGlobalStructure >> generateCASTSetFieldTo: aTSendNode [ +CCodeGeneratorGlobalStructure >> generateCASTSetFieldTo: aTSendNode [ | structType fieldName fieldVale setFieldStatements | - self assert: aTSendNode arguments size = 2. fieldName := aTSendNode arguments first. fieldVale := aTSendNode arguments second. - + structType := self structTypeFor: aTSendNode receiver. - - - setFieldStatements := structType asClass allSlots collect: [ :slot | - | comparison | - - comparison := TSendNode - receiver: (TSendNode - receiver: (TConstantNode value: slot name asString) - selector: 'strcmp:' - arguments: { fieldName }) - selector: '=' - arguments: { TConstantNode value: 0 }. - - TSendNode - receiver: comparison - selector: 'ifTrue:' - arguments: { - TStatementListNode - statements: { - TSendNode - receiver: aTSendNode receiver - selector: (slot name, ':') - arguments: { fieldVale } - } - } - - ]. - - ^ CCompoundStatementNode statements: (setFieldStatements collect: [ :e | e asCASTIn: self]). + + setFieldStatements := (structType asClassInEnvironment: + self class environment) allSlots collect: [ + :slot | + | comparison | + comparison := TSendNode + receiver: (TSendNode + receiver: + (TConstantNode value: + slot name asString) + selector: 'strcmp:' + arguments: { fieldName }) + selector: '=' + arguments: + { (TConstantNode value: 0) }. + + TSendNode + receiver: comparison + selector: 'ifTrue:' + arguments: + { (TStatementListNode statements: + { (TSendNode + receiver: aTSendNode receiver + selector: slot name , ':' + arguments: { fieldVale }) }) } ]. + + ^ CCompoundStatementNode statements: + (setFieldStatements collect: [ :e | e asCASTIn: self ]) ] { #category : #'CAST translation' } @@ -242,8 +240,10 @@ CCodeGeneratorGlobalStructure >> generateCASTWithFieldsDoSeparatedBy: aTSendNode structType := self structTypeFor: aTSendNode receiver. - allFieldArguments := structType asClass allSlots collect: [ :slot | - { + allFieldArguments := (structType asClassInEnvironment: + self class environment) allSlots collect: [ + :slot | + { (TConstantNode value: slot name asString). (TSendNode receiver: aTSendNode receiver @@ -253,10 +253,10 @@ CCodeGeneratorGlobalStructure >> generateCASTWithFieldsDoSeparatedBy: aTSendNode allRewrittenStatements := OrderedCollection new. allFieldArguments - do: [ :fieldArgs | + do: [ :fieldArgs | allRewrittenStatements addAll: (self bindBlock: fieldBlock withArgs: fieldArgs) ] - separatedBy: [ + separatedBy: [ allRewrittenStatements addAll: blockSeparatorStatements ]. ^ CCompoundStatementNode statements: diff --git a/smalltalksrc/Melchor/MLVMCCodeGenerator.class.st b/smalltalksrc/Melchor/MLVMCCodeGenerator.class.st index 7c86374c61..3023b538d9 100644 --- a/smalltalksrc/Melchor/MLVMCCodeGenerator.class.st +++ b/smalltalksrc/Melchor/MLVMCCodeGenerator.class.st @@ -5,7 +5,7 @@ Class { 'vmClass', 'vmMaker' ], - #category : #Melchor + #category : 'Melchor' } { #category : #'C code generator' } diff --git a/smalltalksrc/Slang-Tests/MockConstantClass.class.st b/smalltalksrc/Slang-Tests/MockConstantClass.class.st index 209602e45c..0390f2b484 100644 --- a/smalltalksrc/Slang-Tests/MockConstantClass.class.st +++ b/smalltalksrc/Slang-Tests/MockConstantClass.class.st @@ -1,9 +1,17 @@ Class { #name : #MockConstantClass, #superclass : #Object, - #category : #'Slang-Tests' + #category : 'Slang-Tests' } +{ #category : #accessing } +MockConstantClass >> bindingOf: aString [ + + "For compatibility, used by the code generator to lookup for constants" + + ^ nil +] + { #category : #testing } MockConstantClass >> defineAtCompileTime: aString [ diff --git a/smalltalksrc/Slang-Tests/MockSlangClass.class.st b/smalltalksrc/Slang-Tests/MockSlangClass.class.st index 576a81262c..a555fa8074 100644 --- a/smalltalksrc/Slang-Tests/MockSlangClass.class.st +++ b/smalltalksrc/Slang-Tests/MockSlangClass.class.st @@ -7,9 +7,17 @@ Class { 'objectMemoryClass', 'initializationOptions' ], - #category : #'Slang-Tests' + #category : 'Slang-Tests' } +{ #category : #testing } +MockSlangClass >> bindingOf: aString [ + + "For compatibility, used by the code generator to lookup for constants" + + ^ nil +] + { #category : #accessing } MockSlangClass >> cogitClass [ diff --git a/smalltalksrc/Slang-Tests/SLTypeHarmonizationTest.class.st b/smalltalksrc/Slang-Tests/SLTypeHarmonizationTest.class.st index d04d5dcc80..d8760fafd8 100644 --- a/smalltalksrc/Slang-Tests/SLTypeHarmonizationTest.class.st +++ b/smalltalksrc/Slang-Tests/SLTypeHarmonizationTest.class.st @@ -4,7 +4,7 @@ Class { #instVars : [ 'types' ], - #category : #'Slang-Tests' + #category : 'Slang-Tests' } { #category : #running } diff --git a/smalltalksrc/Slang-Tests/SlangBasicTypeInferenceTestClass.class.st b/smalltalksrc/Slang-Tests/SlangBasicTypeInferenceTestClass.class.st index 0f7e9cc7fe..4444b7d2f2 100644 --- a/smalltalksrc/Slang-Tests/SlangBasicTypeInferenceTestClass.class.st +++ b/smalltalksrc/Slang-Tests/SlangBasicTypeInferenceTestClass.class.st @@ -1,7 +1,7 @@ Class { #name : #SlangBasicTypeInferenceTestClass, #superclass : #SlangClass, - #category : #'Slang-Tests' + #category : 'Slang-Tests' } { #category : #constant } diff --git a/smalltalksrc/Slang/CCodeGenerator.class.st b/smalltalksrc/Slang/CCodeGenerator.class.st index 18cc004e39..0d2074fb33 100644 --- a/smalltalksrc/Slang/CCodeGenerator.class.st +++ b/smalltalksrc/Slang/CCodeGenerator.class.st @@ -48,7 +48,7 @@ Class { #classVars : [ 'NoRegParmsInAssertVMs' ], - #category : #'Slang-CodeGeneration' + #category : 'Slang-CodeGeneration' } { #category : #'class initialization' } @@ -67,12 +67,17 @@ CCodeGenerator class >> isVarargsSelector: aRBSelectorNode [ { #category : #'C code generator' } CCodeGenerator class >> monticelloDescriptionFor: aClass [ "Answer a suitable Monticello package stamp to include in the header." + | pkgInfo pkg uuid | pkgInfo := aClass package. - pkg := MCWorkingCopy allManagers detect: [:ea| ea packageName = pkgInfo packageName]. - pkg ancestry ancestors isEmpty ifFalse: - [uuid := pkg ancestry ancestors first id]. - ^aClass name, (pkg modified ifTrue: [' * '] ifFalse: [' ']), pkg ancestry ancestorString, ' uuid: ', uuid asString + pkg := MCWorkingCopy allWorkingCopies detect: [ :ea | + ea packageName = pkgInfo name ]. + pkg ancestry ancestors isEmpty ifFalse: [ + uuid := pkg ancestry ancestors first id ]. + ^ aClass name , (pkg modified + ifTrue: [ ' * ' ] + ifFalse: [ ' ' ]) , pkg ancestry ancestorString , ' uuid: ' + , uuid asString ] { #category : #'C code generator' } @@ -279,15 +284,14 @@ CCodeGenerator >> addMethodsForTranslatedPrimitives: classAndSelectorList [ ] { #category : #public } -CCodeGenerator >> addPoolVarsFor: aClass [ +CCodeGenerator >> addPoolVarsFor: aClass [ "Add the pool variables for the given class to the code base as constants." - (aClass sharedPools reject: [:pool| pools includes: pool]) do: - [:pool | + (aClass sharedPools reject: [ :pool | pools includes: pool ]) do: [ + :pool | pools add: pool. - pool bindingsDo: - [:binding | - self addConstantForBinding: binding]] + pool classVariables do: [ :binding | + self addConstantForBinding: binding ] ] ] { #category : #public } @@ -715,7 +719,7 @@ CCodeGenerator >> checkClassForNameConflicts: aClass [ "and in shared pools" (aClass sharedPools reject: [ :pool | pools includes: pool ]) do: [ :pool | - pool bindingsDo: [ :assoc | + pool classVariables do: [ :assoc | (constants includesKey: assoc key) ifTrue: [ self error: 'Constant ' , assoc key @@ -4889,12 +4893,8 @@ CCodeGenerator >> structTargetKindForVariableName: varName [ "" { #category : #utilities } CCodeGenerator >> superclassOrder: classes [ - ^[ChangeSet superclassOrder: classes] "Squeak" - on: MessageNotUnderstood - do: [ :ex| - ex message selector == #superclassOrder: ifFalse: - [ex pass]. - Class superclassOrder: classes] "Pharo" + + ^ Class superclassOrder: classes ] { #category : #accessing } diff --git a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st index 8a363ea4cc..4683efa108 100644 --- a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st +++ b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st @@ -67,7 +67,7 @@ Class { 'CogCompilationConstants', 'CogRTLOpcodes' ], - #category : #'VMMaker-JIT' + #category : 'VMMaker-JIT' } { #category : #translation } @@ -151,11 +151,8 @@ CogAbstractInstruction class >> initializeSpecificOpcodes: opcodeSymbolSequence [:ea| ea key]. "Declare opcodeSymbolSequence's elements from LastRTLCode on up." - opcodeSymbolSequence withIndexDo: - [:classVarName :value| - pool - declare: classVarName from: Undeclared; - at: classVarName put: value + LastRTLCode - 1] + opcodeSymbolSequence withIndexDo: [:classVarName :value| + pool at: classVarName put: value + LastRTLCode - 1] ] { #category : #translation } diff --git a/smalltalksrc/VMMaker/CogRTLOpcodes.class.st b/smalltalksrc/VMMaker/CogRTLOpcodes.class.st index 9889ca1bb3..e24963aacc 100644 --- a/smalltalksrc/VMMaker/CogRTLOpcodes.class.st +++ b/smalltalksrc/VMMaker/CogRTLOpcodes.class.st @@ -161,7 +161,7 @@ Class { 'ZeroExtend32RR', 'ZeroExtend8RR' ], - #category : #'VMMaker-JIT' + #category : 'VMMaker-JIT' } { #category : #'class initialization' } @@ -345,15 +345,12 @@ CogRTLOpcodes class >> initialize [ "Find the variables directly referenced by this method" refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect: [:ea| ea key]. - "Move to Undeclared any opcodes in classPool not in opcodes or this method." - (classPool keys reject: [:k| (opcodeNames includes: k) or: [refs includes: k]]) do: - [:k| - Undeclared declare: k from: classPool]. + "Declare as class variables and number elements of opcodeArray above" opcodeNames withIndexDo: [:classVarName :value| + Undeclared removeKey: classVarName ifAbsent: [ "Nothing" ]. self classPool - declare: classVarName from: Undeclared; at: classVarName put: value]. "For CogAbstractInstruction>>isJump etc..." diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index b1796502a7..d1fe4044a2 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -314,7 +314,7 @@ Class { 'generatorTable', 'primitiveTable' ], - #category : #'VMMaker-JIT' + #category : 'VMMaker-JIT' } { #category : #translation } @@ -612,8 +612,7 @@ Cogit class >> declareCVarsIn: aCCodeGenerator [ "In C the abstract opcode names clash with the Smalltak generator syntactic sugar. Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic sugar to avoid the clash." - (self organization listAtCategoryNamed: - #'abstract instructions') do: [ :s | + (self selectorsInProtocol: #'abstract instructions') do: [ :s | aCCodeGenerator addSelectorTranslation: s to: 'g' , (aCCodeGenerator cFunctionNameFor: s) ]. @@ -3916,14 +3915,14 @@ Cogit >> ceCheckForInterruptTrampoline: anInteger [ ceCheckForInterruptTrampoline := anInteger ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } Cogit >> ceDereferenceSelectorIndex [ ^ objectRepresentation selectorIndexDereferenceRoutine ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } Cogit >> ceDereferenceSelectorIndex: anInteger [ @@ -8194,7 +8193,7 @@ Cogit >> getPrimitiveIndex [ ^primitiveIndex ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } Cogit >> guardPageSize: anInteger [ @@ -8781,7 +8780,7 @@ Cogit >> labelForSimulationAccessor: blockOrMessageSendOrSelector [ ifFalse: [blockOrMessageSendOrSelector]]) ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } Cogit >> lastNInstructions: aCollection [ lastNInstructions := aCollection @@ -10031,7 +10030,7 @@ Cogit >> methodZoneBase [ ^methodZoneBase ] -{ #category : #'*VMMaker-Tests' } +{ #category : #accessing } Cogit >> methodZoneBase: anInteger [ methodZoneBase := anInteger @@ -10741,7 +10740,7 @@ Cogit >> promptForBreakPC [ self breakPC: pc ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } Cogit >> receiverTags: anInteger [ receiverTags := anInteger ] @@ -11728,7 +11727,7 @@ Cogit >> stackPointerAddress [ ^coInterpreter stackPointerAddress ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } Cogit >> stackPointerAlignment [ ^ backEnd stackPointerAlignment diff --git a/smalltalksrc/VMMaker/Cogit.extension.st b/smalltalksrc/VMMaker/Cogit.extension.st deleted file mode 100644 index 4492699f91..0000000000 --- a/smalltalksrc/VMMaker/Cogit.extension.st +++ /dev/null @@ -1,7 +0,0 @@ -Extension { #name : #Cogit } - -{ #category : #'*VMMaker-Tests' } -Cogit >> methodZoneBase: anInteger [ - - methodZoneBase := anInteger -] diff --git a/smalltalksrc/VMMaker/CompiledMethod.extension.st b/smalltalksrc/VMMaker/CompiledMethod.extension.st index 159a2598c2..b39edfe7f7 100644 --- a/smalltalksrc/VMMaker/CompiledMethod.extension.st +++ b/smalltalksrc/VMMaker/CompiledMethod.extension.st @@ -1,5 +1,15 @@ Extension { #name : #CompiledMethod } +{ #category : #'*VMMaker' } +CompiledMethod >> abstractBytecodeMessageAt: pc [ + + ^ [ + (InstructionStream new method: self pc: pc) + interpretNextInstructionFor: nil ] + on: MessageNotUnderstood + do: [ :ex | ex message ] +] + { #category : #'*VMMaker-support' } CompiledMethod >> abstractDetailedSymbolic [ ^String streamContents: [:s| (RelativeDetailedInstructionPrinter on: self) printInstructionsOn: s] diff --git a/smalltalksrc/VMMaker/ComposedImageReader.class.st b/smalltalksrc/VMMaker/ComposedImageReader.class.st index a46e37e9dc..1a19d247e1 100644 --- a/smalltalksrc/VMMaker/ComposedImageReader.class.st +++ b/smalltalksrc/VMMaker/ComposedImageReader.class.st @@ -3,7 +3,7 @@ Class { #superclass : #AbstractComposedImageAccess, #traits : 'TImageReader', #classTraits : 'TImageReader classTrait', - #category : #'VMMaker-ImageFormat' + #category : 'VMMaker-ImageFormat' } { #category : #reading } diff --git a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st index 323609b917..9509ffd0ab 100644 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st +++ b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st @@ -20,7 +20,7 @@ Class { 'VMObjectIndices', 'VMWellKnownPrimitivesConstants' ], - #category : #'VMMaker-JIT' + #category : 'VMMaker-JIT' } { #category : #translation } @@ -293,6 +293,12 @@ SimpleStackBasedCogit >> ceShortCutTraceStore: aProcessorSimulationTrap [ into: (processor registerAt: ReceiverResultReg)] ] +{ #category : #accessing } +SimpleStackBasedCogit >> ceStoreContextInstVarTrampoline: anInteger [ + + ceStoreContextInstVarTrampoline := anInteger +] + { #category : #'compile abstract instructions' } SimpleStackBasedCogit >> compileFrameBuild [ "Build a frame for a CogMethod activation. See CoInterpreter class>>initializeFrameIndices. @@ -1018,7 +1024,7 @@ SimpleStackBasedCogit >> endPC: anInteger [ endPC := anInteger ] -{ #category : #'*VMMaker-Tests' } +{ #category : #accessing } SimpleStackBasedCogit >> entryOffset: anInteger [ cmEntryOffset := anInteger @@ -1034,6 +1040,12 @@ SimpleStackBasedCogit >> evaluateTrampolineCallBlock: block protectLinkRegIfNot: [ block value ]. ] +{ #category : #accessing } +SimpleStackBasedCogit >> extA: anInteger [ + + extA := anInteger +] + { #category : #'bytecode generators' } SimpleStackBasedCogit >> extendedPushBytecode [ | variableType variableIndex | diff --git a/smalltalksrc/VMMaker/SimpleStackBasedCogit.extension.st b/smalltalksrc/VMMaker/SimpleStackBasedCogit.extension.st deleted file mode 100644 index 0fce0f7c91..0000000000 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.extension.st +++ /dev/null @@ -1,7 +0,0 @@ -Extension { #name : #SimpleStackBasedCogit } - -{ #category : #'*VMMaker-Tests' } -SimpleStackBasedCogit >> entryOffset: anInteger [ - - cmEntryOffset := anInteger -] diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index 5187265270..3fd87c793f 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -458,7 +458,7 @@ Class { 'VMStackFrameOffsets', 'VMWellKnownPrimitivesConstants' ], - #category : #'VMMaker-Interpreter' + #category : 'VMMaker-Interpreter' } { #category : #translation } @@ -1070,8 +1070,8 @@ StackInterpreter class >> initializePrimitiveTable [ (63 primitiveStringAt) (64 primitiveStringAtPut) "The stream primitives no longer pay their way; normal Smalltalk code is faster." - (65 primitiveStartProfiling)"was primitiveNext" - (66 primitiveStopProfiling) "was primitiveNextPut" + (65 0)"was primitiveNext" + (66 0) "was primitiveNextPut" (67 0 "a.k.a. primitiveFail but faster because primitiveFail won't even be called") "was primitiveAtEnd" "StorageManagement Primitives (68-79)" @@ -1465,14 +1465,14 @@ StackInterpreter class >> isNonArgumentImplicitReceiverVariableName: aString [ StackInterpreter class >> isObjectAccessor: selector [ "Answer if selector is one of fetchPointer:ofObject: storePointer:ofObject:withValue: et al." - ^(InterpreterProxy whichCategoryIncludesSelector: selector) = #'object access' - or: [(SpurMemoryManager whichCategoryIncludesSelector: selector) = #'object access'] + ^(InterpreterProxy protocolNameOfSelector: selector) = #'object access' + or: [(SpurMemoryManager protocolNameOfSelector: selector) = #'object access'] ] { #category : #'spur compilation support' } StackInterpreter class >> isStackAccessor: selector [ - ^(StackInterpreter whichCategoryIncludesSelector: selector) = #'stack access' + ^(StackInterpreter protocolNameOfSelector: selector) = #'stack access' ] { #category : #translation } @@ -1663,7 +1663,6 @@ StackInterpreter class >> reorganizeAsISeeFit [ { #category : #translation } StackInterpreter class >> requiredMethodNames: options [ - "Answer the list of method names that should be retained for export or other support reasons" | requiredList | @@ -1688,10 +1687,9 @@ StackInterpreter class >> requiredMethodNames: options [ (self primitiveTable select: [ :each | each isSymbol ]). "InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those" - InterpreterProxy organization categories do: [ :cat | - (cat ~= 'initialize' and: [ cat ~= 'private' ]) ifTrue: [ - requiredList addAll: - (InterpreterProxy organization listAtCategoryNamed: cat) ] ]. + InterpreterProxy protocolNames do: [ :cat | + (cat ~= 'initialize' and: [ cat ~= 'private' ]) ifTrue: [ + requiredList addAll: (InterpreterProxy selectorsInProtocol: cat) ] ]. ^ requiredList ] diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index 361a6937c2..f41f08ebeb 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -5,7 +5,7 @@ Class { 'LibFFIConstants', 'VMBasicConstants' ], - #category : #'VMMaker-Interpreter' + #category : 'VMMaker-Interpreter' } { #category : #initialization } diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index 488f108dcb..5e06d40992 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -155,7 +155,7 @@ Class { 'numPushNilsFunction', 'pushNilSizeFunction' ], - #category : #'VMMaker-JIT' + #category : 'VMMaker-JIT' } { #category : #translation } @@ -1678,11 +1678,13 @@ StackToRegisterMappingCogit >> genForwardersInlinedIdenticalOrNotIf: orNot [ { #category : #'bytecode generator stores' } StackToRegisterMappingCogit >> genGenericStorePop: popBoolean MaybeContextSlotIndex: slotIndex needsStoreCheck: needsStoreCheck needsRestoreRcvr: needsRestoreReceiver needsImmutabilityCheck: needsImmCheck [ + "Generates a store into an object that *may* be a context. Multiple settings: - needsStoreCheck (young into old object check) - needRestoreRcvr (ensures the recevier is live across the store) - needsImmCheck (do the call-back if the receiver is immutable)" + @@ -1691,32 +1693,36 @@ StackToRegisterMappingCogit >> genGenericStorePop: popBoolean MaybeContextSlotIn involve wholesale reorganization of stack pages, and the only way to preserve the execution state of an activation in that case is if it has a frame." self assert: needsFrame. - self - cppIf: IMMUTABILITY - ifTrue: - [needsImmCheck - ifTrue: - [mutableJump := objectRepresentation genJumpMutable: ReceiverResultReg scratchReg: TempReg. - objectRepresentation genStoreTrampolineCall: slotIndex. - needsRestoreReceiver ifTrue: [ self putSelfInReceiverResultReg ]. - immutabilityFailure := self Jump: 0. - mutableJump jmpTarget: self Label.]]. - self ssPop: 1. - self ssAllocateCallReg: ClassReg and: SendNumArgsReg. "for ceStoreContextInstVarTrampoline" - self ssPush: 1. + + self ssAllocateRequiredReg: ClassReg upThrough: simStackPtr - 1. "If already classReg don't spill it" + "we replace the top value for the flush" + self ssStoreAndReplacePop: popBoolean toReg: ClassReg. + self ssFlushTo: simStackPtr. + + self cppIf: IMMUTABILITY ifTrue: [ + needsImmCheck ifTrue: [ + mutableJump := objectRepresentation + genJumpMutable: ReceiverResultReg + scratchReg: TempReg. + objectRepresentation genStoreTrampolineCall: slotIndex. + + needsRestoreReceiver ifTrue: [ self putSelfInReceiverResultReg ]. + immutabilityFailure := self Jump: 0. + mutableJump jmpTarget: self Label ] ]. + objectRepresentation genLoadSlot: SenderIndex sourceReg: ReceiverResultReg destReg: TempReg. - self ssStoreAndReplacePop: popBoolean toReg: ClassReg. - self ssFlushTo: simStackPtr. + self MoveCq: slotIndex R: SendNumArgsReg. self CallRT: ceStoreContextInstVarTrampoline. - self + + self cppIf: IMMUTABILITY - ifTrue: - [needsImmCheck ifTrue:[immutabilityFailure jmpTarget: self Label]]. - ^0 + ifTrue: [ + needsImmCheck ifTrue: [ immutabilityFailure jmpTarget: self Label ] ]. + ^ 0 ] { #category : #'bytecode generator stores' } @@ -4580,15 +4586,22 @@ StackToRegisterMappingCogit >> ssSelfDescriptor [ { #category : #'simulation stack' } StackToRegisterMappingCogit >> ssStoreAndReplacePop: popBoolean toReg: reg [ - "In addition to ssStorePop:toReg:, if this is a store and not - a popInto I change the simulated stack to use the register - for the top value" + + "Move the top of the stack to a register. + If the top of the stack must be popped, pop it. + If the top of the stack must NOT be popped, and was in memory (spilled), make it into the register" + | topSpilled | topSpilled := self ssTop spilled. - self ssStorePop: (popBoolean or: [topSpilled]) toReg: reg. - popBoolean ifFalse: - [ topSpilled ifFalse: [self ssPop: 1]. - self ssPushRegister: reg ]. + self ssStorePop: (popBoolean or: [ topSpilled ]) toReg: reg. + + "If popBoolean is true, we already popped, do not pop again" + popBoolean ifTrue: [ ^ self ]. + + "If the top was spilled, we popped it before and moved it to `reg`. + Now replace its entry by `reg`, making it *unspilled*" + topSpilled ifFalse: [ self ssPop: 1 ]. + self ssPushRegister: reg ] { #category : #'simulation stack' } @@ -4823,6 +4836,12 @@ StackToRegisterMappingCogit >> updateSimSpillBase [ self assert: (simSpillBase > simStackPtr or: [(self simStackAt: simSpillBase) spilled == false]) ] +{ #category : #accessing } +StackToRegisterMappingCogit >> useTwoPaths: aBoolean [ + + useTwoPaths := aBoolean +] + { #category : #'span functions' } StackToRegisterMappingCogit >> v4PushNilSize: aMethodObj numInitialNils: numInitialNils [ "77 01001101 Push false [* 1:true, 2:nil, 3:thisContext, ..., -N: pushExplicitOuter: N, N = Extend B] diff --git a/smalltalksrc/VMMaker/VMMakerConfiguration.class.st b/smalltalksrc/VMMaker/VMMakerConfiguration.class.st index 8db057c9a4..f11efbf066 100644 --- a/smalltalksrc/VMMaker/VMMakerConfiguration.class.st +++ b/smalltalksrc/VMMaker/VMMakerConfiguration.class.st @@ -4,7 +4,7 @@ Class { #classVars : [ 'DirNames' ], - #category : #'VMMaker-Slang' + #category : 'VMMaker-Slang' } { #category : #accessing } @@ -88,7 +88,7 @@ VMMakerConfiguration class >> defaultInterpreterClass [ VMMakerConfiguration class >> generateConfiguration [ "VMMaker generateConfiguration" | configCategoryName selectors | - configCategoryName := self class whichCategoryIncludesSelector: thisContext selector. + configCategoryName := self class protocolNameOfSelector: thisContext selector. selectors := Set new. self class organization categories do: [:cat| diff --git a/smalltalksrc/VMMakerCompatibilityForPharo6/RBMethodNode.extension.st b/smalltalksrc/VMMakerCompatibilityForPharo6/RBMethodNode.extension.st index 6f6d1df08e..6c20da27f2 100644 --- a/smalltalksrc/VMMakerCompatibilityForPharo6/RBMethodNode.extension.st +++ b/smalltalksrc/VMMakerCompatibilityForPharo6/RBMethodNode.extension.st @@ -19,7 +19,7 @@ RBMethodNode >> asTranslationMethodOfClass: aTMethodClass [ ^aTMethodClass new setSelector: selector - definingClass: compilationContext getClass + definingClass: compilationContext semanticScope targetClass args: arguments locals: ((self allDefinedVariables copyWithoutAll: (arguments collect: #name)) collect: [:string| string -> string]) block: (body lastIsReturn @@ -58,7 +58,7 @@ RBMethodNode >> asTranslationMethodOfClass: aTMethodClass forCodeGenerator: aCod ^aTMethodClass new setSelector: renamedSelector - definingClass: compilationContext getClass + definingClass: compilationContext semanticScope targetClass args: arguments locals: ((self allDefinedVariables copyWithoutAll: (arguments collect: #name)) collect: [:string| string -> string]) block: (body lastIsReturn diff --git a/smalltalksrc/VMMakerTests/VMAbstractImageFormatTest.class.st b/smalltalksrc/VMMakerTests/VMAbstractImageFormatTest.class.st index 2fe309b2e0..c8fb4910de 100644 --- a/smalltalksrc/VMMakerTests/VMAbstractImageFormatTest.class.st +++ b/smalltalksrc/VMMakerTests/VMAbstractImageFormatTest.class.st @@ -2,9 +2,11 @@ Class { #name : #VMAbstractImageFormatTest, #superclass : #VMSpurInitializedOldSpaceTest, #instVars : [ - 'imageReader' + 'imageReader', + 'imageReaderClass', + 'imageWriterClass' ], - #category : #'VMMakerTests-ImageFormat' + #category : 'VMMakerTests-ImageFormat' } { #category : #accessing } @@ -35,7 +37,6 @@ VMAbstractImageFormatTest >> saveImage [ { #category : #running } VMAbstractImageFormatTest >> setUp [ - | imageReaderClass | super setUp. "Objects should be registerd in Special Object Array, as they are validated while loading" @@ -51,6 +52,8 @@ VMAbstractImageFormatTest >> setUp [ imageReaderClass := useComposedImageFormat ifTrue: [ ComposedImageReader ] ifFalse: [ SpurImageReader ]. imageReader := imageReaderClass newWithMemory: memory andInterpreter: interpreter. + interpreter imageReaderWriter useComposedImageFormatAsDefault: useComposedImageFormat. + "ByteArrayClass is asserted while loading image" memory classByteArray: (self newClassInOldSpaceWithSlots: 0 instSpec: (memory byteFormatForNumBytes: 0)). memory ensureBehaviorHash: memory classByteArray. diff --git a/smalltalksrc/VMMakerTests/VMJITVMPrimitiveTest.class.st b/smalltalksrc/VMMakerTests/VMJITVMPrimitiveTest.class.st index a12c1df861..5d4aef5a4f 100644 --- a/smalltalksrc/VMMakerTests/VMJITVMPrimitiveTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJITVMPrimitiveTest.class.st @@ -1,7 +1,7 @@ Class { #name : #VMJITVMPrimitiveTest, #superclass : #VMSimpleStackBasedCogitAbstractTest, - #category : #'VMMakerTests-JitTests' + #category : 'VMMakerTests-JitTests' } { #category : #'tests - primitiveMethodXray' } @@ -60,7 +60,7 @@ VMJITVMPrimitiveTest >> testPrimitiveMethodXRayShouldNotCompile [ "This test is only valid as far as the method is the same. It should be a method with so many literals that the compiler does not even try to compile it." target := (CogARMv8Compiler class>>#initialize). - self assert: target bytecodes hash equals: 129771193. + self assert: target bytecodes hash equals: 46085044. methodToXray := self createMethodOopFromHostMethod: target. interpreter push: methodToXray. diff --git a/smalltalksrc/VMMakerTests/VMJitMethodTest.class.st b/smalltalksrc/VMMakerTests/VMJitMethodTest.class.st index 8e27c1cdd4..358544735e 100644 --- a/smalltalksrc/VMMakerTests/VMJitMethodTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitMethodTest.class.st @@ -4,7 +4,7 @@ Class { #pools : [ 'CogRTLOpcodes' ], - #category : #'VMMakerTests-JitTests' + #category : 'VMMakerTests-JitTests' } { #category : #'as yet unclassified' } @@ -26,6 +26,89 @@ VMJitMethodTest >> comparingSmallIntegers: aBitmap [ ^ 23 ] +{ #category : #accessing } +VMJitMethodTest >> filter: aGlyphForm [ + "This method is here only for a test" + + "aGlyphForm should be 3x stretched 8 bit GlyphForm" + | w h s answer rowstart bytes word littleEndian shift v a colorVal i + prevG prevB r g b nextR nextG filters rfilter gfilter bfilter + balR balG balB | + + "correctionFactor := 0.0 ." + filters := FreeTypeSettings current subPixelFilters. + rfilter := filters at: 1. + gfilter := filters at: 2. + bfilter := filters at: 3. + bytes := aGlyphForm bits. + w := aGlyphForm width. + h := aGlyphForm height. + answer := aGlyphForm class extent: ((aGlyphForm width / 3) ceiling + 2)@h depth: 32. + answer + offset: (aGlyphForm offset x / 3) rounded@(aGlyphForm offset y); + advance: (aGlyphForm advance / 3) rounded; + linearAdvance: aGlyphForm linearAdvance. + s := w + 3 >> 2. + littleEndian := aGlyphForm isLittleEndian. + 0 to: h - 1 do: [:y | + rowstart := (y * s)+1. + prevG := prevB :=0. + 0 to: w - 1 by: 3 do:[:x | + 0 to: 2 do:[:subpixelindex | + i := x + subpixelindex. + word := bytes at: rowstart + (i//4). + shift := -8* (littleEndian + ifTrue:[i bitAnd: 3] + ifFalse:[3-(i bitAnd: 3)]). + v := (word bitShift: shift) bitAnd: 16rFF. + subpixelindex = 0 ifTrue:[r := v]. + subpixelindex = 1 ifTrue:[g := v]. + subpixelindex = 2 ifTrue:[b := v]]. + x >= (w-3) + ifTrue:[nextR := nextG := 0] + ifFalse:[ + 0 to: 1 do:[:subpixelindex | + i := x + 3 + subpixelindex. + word := bytes at: rowstart + (i//4). + shift := -8* (littleEndian + ifTrue:[i bitAnd: 3] + ifFalse:[3-(i bitAnd: 3)]). + v := (word bitShift: shift) bitAnd: 16rFF. + subpixelindex = 0 ifTrue:[nextR := v]. + subpixelindex = 1 ifTrue:[nextG := v]]]. + "balance r g b" + balR := (prevG*(rfilter at: 1))+ + (prevB*(rfilter at: 2))+ + (r*(rfilter at: 3))+ + (g*(rfilter at: 4))+ + (b*(rfilter at: 5)). + balG := (prevB*(gfilter at: 1))+ + (r*(gfilter at: 2))+ + (g*(gfilter at: 3))+ + (b*(gfilter at: 4))+ + (nextR*(gfilter at: 5)). + balB := (r*(bfilter at: 1))+ + (g*(bfilter at: 2))+ + (b*(bfilter at: 3))+ + (nextR*(bfilter at: 4))+ + (nextG*(bfilter at: 5)). + "luminance := (0.299*balR)+(0.587*balG)+(0.114*balB). + balR := balR + ((luminance - balR)*correctionFactor). + balG := balG + ((luminance - balG)*correctionFactor). + balB := balB + ((luminance - balB)*correctionFactor)." + balR := balR truncated. + balR < 0 ifTrue:[balR := 0] ifFalse:[balR > 255 ifTrue:[balR := 255]]. + balG := balG truncated. + balG < 0 ifTrue:[balG := 0] ifFalse:[balG > 255 ifTrue:[balG := 255]]. + balB := balB truncated. + balB < 0 ifTrue:[balB := 0] ifFalse:[balB > 255 ifTrue:[balB := 255]]. + a := balR + balG + balB > 0 ifTrue:[16rFF] ifFalse:[0]. + colorVal := balB + (balG bitShift: 8) + (balR bitShift: 16) + (a bitShift: 24). + answer bits integerAt: (y*answer width)+(x//3+1) put: colorVal. + prevB := b. prevG := g. "remember the unbalanced values" ]]. + ^answer +] + { #category : #helpers } VMJitMethodTest >> initStack [ @@ -252,7 +335,7 @@ VMJitMethodTest >> testJitCompiledFloat64VectorAddition [ VMJitMethodTest >> testMixedInlinedLiteralsSmoteTest [ | callingMethod | - callingMethod := self jitMethod: (FreeTypeSubPixelAntiAliasedGlyphRenderer>>#filter:). + callingMethod := self jitMethod: (self class>>#filter:). self deny: callingMethod address equals: 0. ] diff --git a/smalltalksrc/VMMakerTests/VMStorePopTest.class.st b/smalltalksrc/VMMakerTests/VMStorePopTest.class.st new file mode 100644 index 0000000000..dc26a7ecf1 --- /dev/null +++ b/smalltalksrc/VMMakerTests/VMStorePopTest.class.st @@ -0,0 +1,93 @@ +Class { + #name : #VMStorePopTest, + #superclass : #VMStackToRegisterMappingCogitTest, + #category : 'VMMakerTests-JitTests' +} + +{ #category : #running } +VMStorePopTest >> jitOptions [ + + ^ super jitOptions + at: #IMMUTABILITY put: true; + yourself +] + +{ #category : #tests } +VMStorePopTest >> testExtendedStoreAndPopIV1ImmutableObjectCallingConvention [ + + | instanceVariableToWrite stopAddress methodWithStoreCheck storeTrampoline | + instanceVariableToWrite := 1. + + "Create an object with at least `instanceVariableToWrite` instance variables. + In memory, instance variables are 0-indexed so substract 1" + obj := self newObjectWithSlots: instanceVariableToWrite. + memory setIsImmutableOf: obj to: true. + + "The receiver should be in a receiver register based on Cog's calling convention" + machineSimulator receiverRegisterValue: obj. + + "Set an address as store check trampoline. + The bytecode below will jump to it if it is a old -> young store" + storeTrampoline := self compileTrampoline: [ + stopAddress := cogit Stop ] named: #ceStoreTrampoline. + cogit objectRepresentation + setAllStoreTrampolinesWith: storeTrampoline. + + cogit ceStoreContextInstVarTrampoline: storeTrampoline. + + "When the store trampoline is called, the assigned value should be in the class register. + Let's put a marker value. If we find this value after calling the trampoline, then the call did not set it." + machineSimulator classRegisterValue: 16rBADF00D. + + "The first byte of the push receiver instance variable bytecode family is used to identify which variable (0-based again)" + cogit byte0: instanceVariableToWrite - 1. + methodWithStoreCheck := self compile: [ + cogit useTwoPaths: false. + cogit methodOrBlockNumTemps: 0. + cogit extA: 0. + cogit initSimStackForFramelessMethod: 0. + cogit byte1: 0. + cogit needsFrame: true. + + cogit genPushLiteral: memory falseObject. + cogit genExtStoreReceiverVariableBytecode ]. + + self runFrom: methodWithStoreCheck until: stopAddress address. + + self assert: machineSimulator classRegisterValue equals: memory falseObject +] + +{ #category : #tests } +VMStorePopTest >> testStoreAndPopIV1ImmutableObjectCallingConvention [ + + | instanceVariableToWrite stopAddress methodWithStoreCheck | + instanceVariableToWrite := 1. + + "Create an object with at least `instanceVariableToWrite` instance variables. + In memory, instance variables are 0-indexed so substract 1" + obj := self newObjectWithSlots: instanceVariableToWrite. + memory setIsImmutableOf: obj to: true. + + "The receiver should be in a receiver register based on Cog's calling convention" + machineSimulator receiverRegisterValue: obj. + + "Set an address as store check trampoline. + The bytecode below will jump to it if it is a old -> young store" + cogit objectRepresentation + setAllStoreTrampolinesWith: (self compileTrampoline: [ + stopAddress := cogit Stop ] named: #ceStoreTrampoline). + + "The first byte of the push receiver instance variable bytecode family is used to identify which variable (0-based again)" + cogit byte0: instanceVariableToWrite - 1. + methodWithStoreCheck := self compile: [ + cogit useTwoPaths: false. + cogit methodOrBlockNumTemps: 0. + cogit initSimStackForFramelessMethod: 0. + + cogit genPushLiteral: memory falseObject. + cogit genStoreAndPopReceiverVariableBytecode ]. + + self runFrom: methodWithStoreCheck until: stopAddress address. + + self assert: machineSimulator classRegisterValue equals: memory falseObject +] diff --git a/src/imageAccess.c b/src/imageAccess.c index 4200fb23d4..429f1cd4cf 100644 --- a/src/imageAccess.c +++ b/src/imageAccess.c @@ -9,6 +9,19 @@ #include #endif +/* + * Windows does not provide this macro for testing + * + */ +#ifdef _WIN32 + #ifndef _S_ISTYPE + #define _S_ISTYPE(mode, mask) (((mode) & _S_IFMT) == (mask)) + #define S_ISREG(mode) _S_ISTYPE((mode), _S_IFREG) + #define S_ISDIR(mode) _S_ISTYPE((mode), _S_IFDIR) + #endif +#endif + + /* * The read and write function uses a 128kb chunk size. * It is based in the analysis of how cp, cat and other tools access the disk